• 
• 



? EXECUTE ESPOL/OISK 



PACKET 
INPUT 
TIME 
HATE 



1510 

314 

1314 

77138 



CARDS FROM ZIP 
WEDNESDAY. 05718/77 



*** MESSAGE OF THE DAY *** 

*** SYSTEM WAS COLD STARTED 5/4/77 USING V23/J7 BACKUP TAPES 

SOME PILES MAY BE AVAILABLE FROM THE 5/4/77 TAPES MADE PRIOR 
TO THE COLD START, BUT SOME FILES WERE LOST 
PLEASE USE USER CARDS IN FRONT OF ALL BATCH JOBS OR PACKETS 



WHEN YOU GET TIRED OF 
SUGGEST A BETTER ONE. 



THIS MESSAGE - 



• * + 



BURROUGHS B57O0 TSMCP MARK XV1,0.69 AND INTRINSICS MARK XVI, 0*00 *** 



# 






EXECU 
? S 
? 
o 
<j 

» 

? 

DATA 



TE ESPOL/DISK 

TACK* 1024 

ILE TAPE= SYMBOL/INTRINS DISK SERIAL 

ILE STUFF' TSSINT/STUFF DISK 

ILE LINE* LINE RACK UP TARE 

ILE 0ISk= TSS/iNT 

ORE* 15000 

CARD 
4IESP0L/DISK/SITE* 3 BOJ 1314 12/31/76 
OKA CUT SER CODE S I TE I ESPOL/DI SK« 3 
IN CARDSESPOL/DISK- 3 
IN SE« SYMBOL INTRINSSESP0L/DISK= 3 

PBT ON MTo 

211 LINE5ESPQL/DISK= 3 

SER TSSINT STUFFiESPOL/DlSK" 3 

SER CHOISK SITE5ESP0L/DISK= 3 



CDB 
DKA 
NEW 
MTD 
DKA 
DKA 



OUT 
OUT 
OUT 



i 

« 
i 



? END, 



3ST 

#OPRTR ST-ED ESPOL/DISK* 3 
30K 

DKA LOK TSSINT STUEE i ESPOL/0 I SK = 3 

CDB REL CARD?ESPOL/OISK= 3 

DKA REL SYMBOL TNTRlNS 8 ESPOL/D ISK= 3 

MTD LOK LINE;eSPOL/D!SK= 3 

DKA OUT SER TSS INT : ESPOL/DI SK= 3 

DKA LOK TSS INTSESPOL/DISKs 3 

CODISK/SITE/STTE= 1200 SEGS — CREATED 05/18/77 AT 13« 15H4«23 

DKA REL CODISK S ITE * ESPOL/D ISK* 3 .,..,.,«,« 

CODE/SITE/SITE- SEGS— CREATED 05/18/77 AT 13:14*35857 

DKA REL CODE S I TE i ESPOL/D I SK- 3 

ESPCI/DISK/SITE= 3*PST= 9:50 EOJ 

FOR FSPOL/OISK* 3:PST* 589, IOT* 146, C0RE=l5360 



» * 



■T I* 



PKT#1510 REMOVED 



4cf' 



c 



LABEL OOOOOOOOOLINT 00177138? EXECUTE ESPOL/DISK 

BURROUGHS R-5700 ESPDL COMPILER MaRK XVI, 0,00 WEDNESDAY, 05/18/77* 



lit 4 PM, 



ESPOL /DISK 



• 



TSS 



/INT 



I 



COMMENT 



• 






n t h i n s i c s mark xvi»o«oo 10/01/74 

* titles b5500/b5700 mark xvi system release 

* file id 3 symbol/intrins tape 10* symr0l1/file000 

* this material is proprietary to burroughs corporation 

* AND IS NOT TO BE REPRODUCED* USED* OR DISCLOSED 

* EXCEPT IN ACCORDANCE WITH PROGRAM LICENSE OR UPON 

* WRITTEN AUTHORIZATION QF THE PATENT DIVISION OF 

* BURROUGHS CORPORATION* DETROIT* MICHIGAN 48232 



• 
• 



BEGIN' 
CEFI 



NE 



• 



COPYRIGHT (C) 1971* 1972* 1974 
BURROUGHS CORPORATION 
AA320206 AA393180 AA332366 



* 
* 



ETRLNG s 5#, 
INTDESCCINTDESC1) * FLAGCI 
INTCALLCINTCALH*INTCALL2) 



CALLINT(CALLINTl) 
COBOLDCl= §167 #* 
FDHTERRl= §134 #* 
EXPI » §20 #» 
LNI ■ 917 #* 
DEXPI « §77 #* 

dlogi - §ioi t> 

CABSI a 953 #* 

SINI b §14 #* 

SQRTI = §13 #* 

ATAN2I = §114 #» 

QMODI s p 65 #* 

DSINI s 0^05 #* 

DSQRTI a §123 #* 

XTQII a §6 #* 

CXTOII = §56 #* 

COSI * §15 #* 

tani = §ni #, 

ARCTANI « §16 #* 
DATANI * §H3 #* 
ARSINI » §116 #* 
GAMMA! s §126 #* 
EDITIT(EDITIT1*EDITIT2*ED1 
EDITIT1*EDITIT2*F 
■153485C1M1I7] 

% EDlTlT(BUFFAODRESS*FIELD 
% WILL EDIT THE VALUE CLOw 
% STARTING AT BUFFADDRESS, 
% ADDRESS. THE WIDTH OF T 
% TD W CHARACTERS (EDITED 



NTDESC1 & 85C1UH73) #* 
= PCINTCALL2 & 85CH4U73* 
INTCALL1»C0C) #* 
= PCCALLINT1 & 85Cll41«7]*XCH*C0C) ** 



TIT3*EDITIT4*EDITIT5) * P(MKS* 
DITlT3*C-n*CEDITIT4),(EDITIT5}* 
*XCH*C0O #* 

WlDTHCW),TYPE*LOWPART*HIGHPART) 
PART*HIGHPART) INTO A FIELD 
EDITIT RETURNS THE ENDING 
HE EDITED FIELD IS CONSTRAINED 
VALUE IS RIGHT JUSTIFIED WITH 



00000000 
00000010 
00000011 
00000012 
00000013 
00000014 

00000015 
00000016 
00000017 
00000018 
00000019 
00000021 
OOOOOlOO 
00000200 
00000210 
00000215 
00000216 
00000218 
00000219 
00000220 
00000221 
00000222 
00000223 
00000224 
00000225 
00000226 
00000227 
00000228 
00000229 
00000230 
00000231 
00000232 
00000233 
00000234 

00000235 
00000236 
00000237 
00000238 
00000239 
00000240 
00000241 
00000242 
00000243 
00000244 
00000245 
00000246 
00000247 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

oooo so 

0000*0 
0000*0 



• 
• 



• 

• 






r «#"•'• 






• 
• 

# 



LEADING BLANKS IF W IS LARGER THAN NEEDED) **■ BUT IF 
W = 0* THEN EDITIT WILL ADJUST THE FIELD WIDTH TO 
ACCOMODATE FULL NUMERICAL SIGNIFICANCE. TYPE-2 *> EDITIT 
WILL CHOOSE BETWEEN REAL* INTEGER, AND DOUBLEPREC I Si ON 
EDITING (DOUBLEPRECISION IS USED IF LOWPART*Q3 f 



TYPE=1 = > USE ONLY INTEGER. 
TYP£=4 *> USE ONLY LOGICAL* 
PRECISION. 

= 33*33:15** 

= 18:33Jl5#* 



TYPE*3 
TYPE*5 






USE 
USE 



ONLY 
ONLY 



REAL, 
DOUBLE* 



33: IBS 15#, 
18» 181 15*# 

33: 15#* 

j.8«i5#; 



CTC 
CTF 
FTC 
ETF 
CF 
FF 
REAL JUNK = 5; 

NAME M£M=2* M = 2* M.£MORY = 2 * 
REAL BLKCNTRL = 5; 
DEFINE DUMPNOW(0UMPNOWl)sP(DUMPN0Wi#0»48*-CQM#DEU0EL)## 
TRACEN0W(TRACEN0Wi,TRACEN0W2)o 

P(TRACEN0W1,1,TRACEN0W2 ,+ , 48, COM, DEL, DEL )#J 

LNSKP, FI, FRMT* LISXJI* 

START 



PROCEDURE 


VALUE 


NAME 


ARRAY 


REAL 


INTEGER 



OUTPUTINT(TEN, FILX, 
LNSKP, FI* 
FRMTC*]j% 



CHSKP, 

lisx;% 



• 



CHSKP, 

filx;% 

TEN[*J" 
I I SX* % 

CHSKP, LNSKP, fin KCZCCT^ 
FORWARDS CODE = ?*ewP = e : ©, INTRINSIC NUMBER*? 
PROCEDURE INTRINSICCDUPE, D, NUMDIM, SIZE, TYPE)*X 

VALljE DUPE, D, NUMDIM, SIZE, TYpE;X 

NAME D*X 

ARRAY DUPEC*3;X 

INTEGER NUMDIM, SIZE, TYPE** cc<fC &**■ 

FORWARDS CODE = 3- g00OO0O- , INTRINSIC 
PROCEDURE INPUTINTCTEN, FILX, 0><ADR* AcT,X 



START 



NUMBERsp 2 



START 



FI* 
VALUE ACT, FIJX 
NAME FILX, LISX;% 
ARRAY TEN[*3* FRMTC*3;% 

REAL EOFL* PARLJX 
INTEGER DKADR, ACT, F I ; X 



FRMT* LISX, EOFL* PARL)JX 



FORWARD*'* 
PROCEDURE DISKSORTCT1* 



CODE = 3^ 00QOOO* - INTRINSIC 



T2* RELA* ENDQ* BINGO, 
OUTF, INF, OPTOG, 



NUMBER*? 
IPFIDX,% 



IPTOG, DKO; 



START 
DKI,% 



OUTPRQ* INPRO, 

TP1* TP2, TP3, TP4* TP5* NT, HIVALU, EQUALS, % 

R, ALFA, CORESIZE, DISKS IzF) *'X 
VALUE OPTOG, IPTOG* NT, HIVALU* EQUALS, R, ALFA** 

CORESIZE* DISKSIZE** 
NAM E T Pi, TP2* TP3* TP4* TPSJX 
REA|. Tl* T2* RELA* ENDQ* BINGO, IPFIDX, OUTPRO, lNPRO,X 

OUTF* INF, DKO* DKI, NT, HIVALU, EQUALS* CORESIZE* 
BOOLEAN OPTOG, IPTOG* ALFA*% 
INTEGER R* OISKSIZEJX w7odttC 



forward;* 



coDE-3-9^etrotrco intrinsic number*? 4 



XWF 

OF REL 

%WF 

XWF 

Xwp 

XWF 

XWF 

XWF 

XWF 

OF REL 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

OF REL 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

OF REL 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 



00000248 T 0000*0 

00000249 T 0000*0 

00000250 T. 0000*0 

00000251 T 0000*0 

00000252 T 0000*0 

00000253 T 0000*0 

00000254 T 0000*0 

00000255 T 0000*0 
00000300 T 0000*0 
00000400 T 0000*0 
00000410 T 0000*0 
00000420 T 0000*0 
00000500 T 0000*0 
00000600 T 0000*0 
00000700 T 0000*0 
00000710 T 0000*0 
00600750 T 0000*0 
00000775 T 0000*0 
00000780 T 0000*0 
00000785 T 0000*0 
00000800 T 0000 

SEGMENT* DISK 

00000900 T 0000 

00001000 T 0000 

00001100 T 0000 

00001200 T 0000 

00001300 T 0000 

00001400 T 0000 

00001500 T 0000 

SEGMENT! DISK 

00001600 T 0000*0 

00001700 T 0000*0 

00001800 T 0000*0 

00001900 T 0000*0 

00002000 T 0000*0 

0§002i00 T 0000*0 

SEGMENT) DISK 

00002200 T 0000*0 

00002300 T 0000*0 

00002400 T 0000*0 

00002500 T 0000*0 

00002600 T 0000*0 

00002700 T 0000*0 

00002800 T 0000*0 

00002900 T 0000*0 

segment; DISK 

00003000 T 0000*0 

00003100 T 0000*0 

00003200 T 0000*0 

00003300 T 0000*0 

00003400 T 0000*0 

00003500 T 0000*0 

00003600 T 0000*0 

00003700 T 0000*0 

00003800 T 0000*0 

00003900 T 0000*0 

00004000 T 0000*0 






JO 
ADDRESS ■ 50005 

*0 

JO 

*0 

*0 

*0 

*0 

*0 
ADDRESS x 00005 



« 

• 
• 



ADDRESS * 00005 



• 
• 



ADDRESS * 00005 



m 
t 






REAL PROCEDURE DlJMPlNTCSN, CV, BV, TIPE'% 

TENS, ALFA* CHAR* FIEL, FQRMT);: 
VALUE SN, CV, BV, TIPE* TENS* AlFA, CHAR* FORMT;X 

NAME FIEL?X 

REAl SN, CV* 8V, TIPE, TENS, A L FA, CHAR, FQRMT?% 

FORWARDS C0DE=42000000, INTRINSIC NUMBER?? 5 
PROCEDURE XTOTHEIINTCBASE, EXPON, M, LOG' EXPHX 

VALUE BASE, EXPON, M* LOG, EXP?% 
REAL BASE, EXPON, M* LOG, EXP;% 

FORWARD*** C0DE = 42254000, INTRINSIC NUMBER** 6 
REAL PROCEDURE ABSINTCX),% 



START 



• 



• 
• 



value x?% 

REAL X** 

forward;* code= 
real procedure signintcx)?* 

VALUE X?X 
REAL X?% 

FORWARD?* CODE= 
INTEGER PROCEDURE ENTIERINTC X ) ? % 

value x?x 

REAL X?* 

FORWARD** COOE= 
REAL PROCEDURE TIMEINTCX3U 

VALUE XI* 
REAL x;% 

FORWARD?* CODE* 
PROCEDURE SQRTINTCX3?! 

VALUE X?* 
REAL X?* 

FORWARD,* CODE* 
PROCEDURE SININTCX)?* 

VALUE X?X 
REAL • X?* 

forward;* code? 
procedure coslntcx)?* 

VALUE X"% 
REAL X?* 

FORWARD, % CODE* 
REAL PROCEDURE ARCTANINTC X ) J % 

VALUE %)% 
REAL X?* 

FORWARD, % CODE* 
PROCEDURE LNlNTCX)?* 

VALUE x;x 
REAL X** 

FORWARD?* CODE* 



INTRINSIC NUMBERS 7 



INTRINSIC NUMBERED 



INTRINSIC NUNBERsPll 



INTRINSIC NUMBER*ei2 



INTRINSIC NUMBER«*l3 



INTRINSIC NUMBER^!* 



INTRINSIC NUM8ER*«H5 



INTRINSIC NUM8ER=§16 



INTRINSIC NUMBER**H7 



START 



START 



START 



START 



START 



START 



START 



START 



START 



START 



XWF 


00004100 


T 


0000*0 


OF REL 


SEGMENT? DISK 


address => 


XWF 


00004200 


T 


0000*0 


XWF 


00004300 


T 


0000*0 


XWF 


00004400 


T 


0000*0 


XwF 


00004500 


T 


oooo »o 


XWF 


00004600 


T 


0000*0 


XWF 


00004700 


T 


0000*0 


OF REL 


SEGMENT? DISK 


address **■ 


XWF 


00004800 


T 


OOOOJO 


XWF 


00004900 


T 


0000*0 


XWF 


00005000 


T 


0000*0 


XWF 


00005100 


T 


0000*0 


OF REL 


segment; DISK 


address * 


XWF 


00005200 


T 


0000*0 


XWF 


00005300 


T 


0000*0 


XWF 


00005400 


T 


0000*0 


XWF 


00005500 


T 


0000*0 


OF REL 


segment; disk 


address ■ 


XWF 


00005600 


T 


0000*0 


XWF 


00005700 


T 


0000*0 


XWF 


00005800 


T 


0000*0 


XWF 


00005900 


T 


OOOOJO 


OF REL 


segment; DISK 


address p 


XWF 


00006000 


T 


0000*0 


XWF 


00006100 


T 


0000*0 


XWF 


00006200 


T 


0000*0 


XWF 


00006300 


T 


0000*0 


OF REL 


segment; DISK 


address = 


XWF 


00006400 


T 


0000*0 


XWF 


00006500 


T 


0000*0 


XWF 


00006600 


T 


0000*0 


XWF 


00006700 


T 


0000*0 


OF REL 


segment; disk 


address * 


XWF 


00006800 


T 


0000*0 


XWF 


00006900 


T 


0000*0 


XWF 


00007000 


T 


0000*0 


XWF 


00007100 


T 


0000*0 


OF REL 


segment; disk 


address i 


XWF 


00007200 


T 


0000*0 


XWF 


00007300 


T 


0000*0 


XWF 


00007400 


T 


0000*0 


XWF 


00007500 


T 


0000*0 


OF REL 


segment; disk 


address a 


XWF 


00007600 


T 


0000*0 


XWF 


00007700 


T 


0000*0 


XWF 


00007800 


T 


000010 


XWF 


00007900 


T 


0000*0 


OF REL 


segment; disk 


address » 


XWF 


00008000 


T 


0000*0 


XWF 


00008100 


T 


0000*0 


XWF 


00008200 


T 


0000*0 


XWF 


00008300 


T 


0000*0 


OF REL 


segment; disk 


ADDRESS * 


XWF 


00008400 


T 


0000*0 


XWF 


00008500 


T 


0000*0 


XWF 


00008600 


T 


0000*0 



00005 






00005 



00005 



00005 



• 



00005 



00005 



©0005 



00005 



©0005 



00005 



00005 



• 

• 
• 



.» • 



REAL PROCEDURE EXPINT(X);* 

value x;* 

REAL V > % 

FORWARD;* CODE* INTRINSIC NUM8ER=P2Q 

REAL PROCEOURF GOTQSOLVERINTCL* X* F, B>i% 

VALUE L' X* F, &)% 

ARRAY Ft*];* 

RFAL L* X* B;% 

FORWARDS CODE* INTRINSIC NUMBER*P2l 

PROCEDURE ALGOLWRITE(TEN, FILX, CHSKP, LNSKP, Flu AEXP** 



START 



START 



ARRY* LINESKIP* CHANSKIP, SUPRS* NUMWOS* TANK)** 
VALUE CHSKP* LNSKP, FI* AEXP* LINESKIP,* 

chanskip* suprs, numwos, tank*x 
name: filx* Tank;x 
array ten[*]> arryc*];* 
integer chskp* lnskp, ei' aexp* llneskip,x 

CHANSKIP* SUPRS* NUMWDS;* , r „to;ci) 
FORWARD;* C0DE»2-6^WK>0, INTRINSIC NUMBER«?22 
PROCEDURE ALGOLREADCTEN* FILX* DKADD* ACT* FI, AEXP** 



START 



START 



arry* eofl* parl* dkadr* code* tank);* 
value act* fit aexp* dkadr* code' tank;* 
name filx* tank;* 

ARRAY TENC* 3* ARRYt*];* 

REAL DKADD, EOFL, PARL* DKADR, CODE;* 

INTEGER ACT* FI, AEXP;* $o5'cc>eco 

FORWARD?* CODE = 3-*0^#e^e# INTRINSIC NUMBER*@23 
PROCEDURE ALGOLSELECT(ACTl> ACT2* TANK, I);* 

VALUE ACT1* ACT2* TANK* IU 

NAME TANKJ* 

INTEGER ACT1* ACT2* I** 

forward;* CODE* 

PROCEDURE COBolFCR;* 



START 



INTRINSIC NUMBER«*2« 



forward;* 
procedure cobolio; 



CODEs/i300O000* INTRINSIC NUM8ER*025 
* GO TO 02700000 



START 



START 



FORWARD;* C0DE*43230000# INTRINSIC NUMBER-P26 
PROCEDURE POLYMERGECTW T2* T3, ENDQ* BINGO* IPFIDX** 

START 
OUTPRQ* INPRO* OUTF, INF* OPTOG* IPTOG* DKO* OKI** 
TPI* TP2* TP3* TP4* TP5* NT, HIVALU* EQUALS** 
R* ALFA, CORESIZE* DISKSIZE);* 
VALUE OPTOG* IPTOG* NT* HIVALU* EQUALS* R, ALFA** 

CORESIZE* DISKSIZE** 
NAME TP1* TP2* TP3, TP4* TP5;* 
REAL Tl* T2* T3, ENDQ* BiNgO* iPFIDX* OUTPRO, INPRO,* 

OUTF* INF* DKO* DKl* NT* HIVALU* EQUALS* R* CORESIZE; 
BOOLEAN HPTOG* IPTOG* ALFA** 
INTEGER DISKSIZE;* 

FORWARD/* CqDE=40140000» INTRINSIC NUM8ER=027 

PROCEDURE STATUSINT(T* O;* 

START 



*WF 00008700 

OF REL SEGMENT) DISK 

*WF 00008800 

*WF 00008900 

*WF 00009000 

*WF 00009100 

OF REL SEGMENT* DISK 

*WF 06009200 

*WF 00009300 

XWF 00009400 

XWF 00009500 

XWF 00009600 

OF REL SEGMENT; DISK 

*WF 00009700 

*WF 00009800 

XWF 00009900 

XWF 00010000 

XWF 0©010100 

*WF 00010200 

*WF 00010300 

XWF 00010400 

XWF 00010500 

OF REL SEGMENT! DISK 

XWF 00010600 

*WF 00010700 

XWF 00010800 

XWF 00010900 

XWF 00011000 

XWF 00011100 

XWF 00011200 

XWF 00011300 

QF REL SEGMENT; DISK 

XWF 00011400 

XWF 00011500 

XWF 00011600 

XWF 00011700 

XWF 00011800 

OF REL SEGMENT; DISK 

XWF 00011900 
00012000 

OF REL SEGMENT; DISK 

XWF 00012100 

XWF 00012200 

OF REL SEGMENT; DISK 

XWF 00012300 

XWF 00012400 

XWF 00012500 

XWF 00012600 

XWF 00012700 

XWF 00012800 

XWF 00012900 

XWF 00013000 

XWF 00013100 

XWF 00013200 

XWF 00013300 

XWF 00013400 

OF REL SEGMENT; DISK 



T 000010 
ADDRESS * 
T 0000*0 
T 0000 '0 
T 0000*0 
T 0000*0 
ADDRESS * 



00005 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



00005 



ADDRESS * 00005 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

ADDRESS ■ 00005 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

ADDRESS =» 00005 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

ADDRESS • 

T 0000*0 

T 0000*0 

ADDRESS » 

T 0000*0 

T 0000*0 

ADDRESS m 



00005 
00005 
00005 



T 
T 
T 
T 
T 

T 

T 

T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000?0 
0000*0 
0000*0 



m 
m 
m 



ADDRESS * 00005 



n 



• 



# 



m 
m 
m 



value t* en 

REAL t;% 

integer cu 

forward;* code= 
real procedure maxintcx);* 

value x;* 

REAL Xi% 

forward;* code* 

REAL PROCEDURE MlNlNyOOJX 

VALUE *}% 
REAL X;% 

FORWARDS C0DE = 
PROCEDURE DELAYINTCARRY, MASK* TIME);* 



INTRINSIC NUMBERsP30 



INTRINSIC NUM8ERs@3l 



INTRINSIC NUMBER**32 



VALUE ARRY, MASK, TI^e;* 
ARRAY ARRYC*];% 
REAt, MASKU 
INTEGER TIME;% 

FORWARDS CQDE= INTRINSIC NUMBER*033 

PROCEDURE SUPERMOVERlNT(SORCE» DEST» AEXP)JX 

VALUE AEXPU 

ARRAY SORCEC*!* DEST[*3;% 

INTEGER AEXP;% 

FORWARD;* CODE* INTRINSIC NUMBER*P34 

PROCEDURE SISo; FORWARD; % INT*35> SEQ#084O00OO 

INTEGER PROCEDURE DELTA ( P 1,P2 3 ; % INT#36, SEQ#00022300 

VALUE P1*P2; INTEGER P1,P2; FORWARD; 
PROCEDURE ICVd; FORWARD; %INT#37*SE0#OO0225OO 

PROCEDURE DYNAMICDIALERCB, A, X* F); 

VALUE R, A, X, F; 

INTEGER Bt A* x; BOOLEAN F; 

FORWARD;* CODEs00022700* INTRINSIC NUMBER«04O 
PROCEDURE SCAN(UPDPDD#PTR>UPDCDD#HISC0UNT»CASEC0DE#CHAR>; 

VALUE PTR* HISCOUNIT* CASECODE* CHARj 

NAME UPDPDD* UPDCDO; 

INTEGER PTR, HISCOUNT, CASECODE, CHaR; 

forward; 

PROCEDURE REPl; FORWARD; 



%WF 

XWF 

%WF 

%WF 

XWF 
START OF REL 

XWF 

XWF 

*WF 

XWF 
START OF REL 

XWF 

XWF 

XWF 

*WF 
START OF REL 

SWF 

XWF 

%WF 

XWF 

XWF 

XWF 
START OF REL 

XWF 

XWF 

%WF 

XWF 

START OF REL 
START OF REL 



START OF REL 
START OF REL 



START OF REL 



procedure compare;fqrward; 
procedure basicprint(type); 



XINT#42*SEQ#08420000 
XINT#43>SEQ#06430000 



VALUE TYPE; 
REAL TYPE; 

FORWARD** C00Ea08500000, INTRINSIC NUMBER*044 
PROCEDURE SWAP! FORWARD; %INT#45>SEQ*'o0023700 

PROCEDURE BASICINPUT(TYPES); 



START OF REL 

START OF REL 

START OF REL 

START OF REL 



000 
000 

000 

000 

000 

segment; 

000 
000 
000 
000 

segment; 

000 
000 
000 

000 

segment; 

000 

ooo 

000 

ooo 

000 
000 

segment; 
ooo 
ooo 
ooo 

000 

000 

segment; 

00© 

segment; 

000 
000 

segment; 

ooo 
segment; 

ooo 

000 
000 
000 

segment; 
ooo 
ooo 

000 
000 
000 

segment; 

000 

segment; 

000 

segment; 
ooo 
ooo 

000 
000 

segment; 

000 



13500 
13600 
13700 
13800 
13900 

DISK 
14000 
14100 
14200 
14300 

DISK 
14400 
14500 
14600 
14700 

DISK 

14800 
14900 

15000 
15100 
15200 
15300 

DISK 
15400 
15500 
15600 
15700 
15800 

DISK 
15900 

DISK 
15950 
16000 

DISK 
16100 

DISK 

16110 
16120 
16130 
16200 

DISK 
16210 
16220 
16230 
16240 
16300 

DISK 
16400 

DISK 
16500 

DISK 
16510 
16520 

16530 

16600 

DISK 

16700 



0000*0 
0000*0 



0000«0 
0000*0 
0000*0 
ADDRESS ■« 
T 0000*0 
T 0000*0 
T 0000*0 

T 0000*0 
AOORESS w 
T 0000*0 
T 0000*0 
T 0000*0 
T 0000*0 
ADDRESS » 



00005 



00005 



• 



00005 



0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 



ADDRESS = 00005 
T 0000*0 
T 0000*0 
T 0000*0 
T OOOO'O 
T 0000*0 
AOORESS • 00005 
T 0000*0 
ADDRESS ■ 00005 
T 0000*0 
T 0000*0 
ADDRESS * 00005 
T 0000*0 
ADDRESS = 00005 
T 0000*0 
T 0000*0 
T 0000*0 
T 0000*0 
ADDRESS w 00005 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
ADDRESS m 
T 0000*0 
ADDRESS • 
T 0000*0 
ADDRESS » 
T 0000*0 
T 0000*0 

T 0000*0 
T 0000*0 
ADDRESS a 
T 0000*0 






00005 
00005 
00005 

00005 






c 



VALUE TYPES/ 
BEAU TYPES' 

FORWARD'* C0D£=08700000, INTRINSIC NUMBERs@46 
PROCEDURE READATACTYPE3I 



START QF REL 



START OF REL 



value type; 
real type' 
forwards 



COOE'08600000* INTRINSIC NUMBER-047 



rffijp kM & £>z-ffzgoo 



m <i fcfrM W&z&m iyft^P ROCEDURE FTINT i FORWARD; % 050 Juu! OZ&O £#&e> 

PROCEDURE FTOUT > FORWARD; 3! 051 JC*l €"iqCct?~ZC 







PcvTkfrHe' cz^ri^CpC 



rz\ 



m 
m 
m 



; FORWARD 
; FORWARD 



PROCEDURE DABS 
PROCEDURE CABS 

PROCEDURE AINT '> FORWARD 

PROCEDURE MATH > FORWARD 

PROCEDURE XTOI /* FORWARD 

PROCEDURE IDINT ; FORWARD 

PROCEDURE FLOAT > FORWARD 

PROCEDURE SNGL * FQRwARD 

PROCEDURE DBLE i FORWARD 

PROCEDURE AMQD ; FORWARD 

PROCEDURE TIME I FORWARD 

PROCEDURE DMQD i FORWARD 

PROCEDURE DMAXl ; FORWARD 

PROCEDURE 0MIN1 ; FORWARD 

PROCEDURE SIGNV * FORWARD 

PROCEDURE DSIGM '> FORWARD 

PROCEDURE 01 IM ; FQRwARD 

PROCEDURE REALP ; FORWARD 

PROCEDURE AIMAG > FORWARD 

PROCEDURE CMPLX ; FORWARD 

PROCEDURE CONJG > FORWARD 

PROCEDURE DEXP ; FORWARD 



X 052 

% 053 
% 054 
% 055 

* 056 
X 057 
% 060 
% 061 
X 062 

% 063 
% 064 

% 065 
2 066 
% 067 
% 070 
% 071 
% 072 
% 073 
% 074 
% 075 
% 076 

* 077 



START 
START 
START 
START 
START 
START 
START 
START 
START 
START 

START 
START 
START 
START 
START 
START 
START 
START 
START 
START 
START 
START 
START 
START 



OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
QF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
QF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 
OF REL 



segment; 

080 
000 
000 
000 

segment; 
ooo 

000 
000 
000 

segment; 

000 

segment; 

000 

segment; 

OiO 

segment; 

ooo 
segment; 

ooo 
segment; 

000 

segment; 

ooo 
segment; 

ooo 
segment; 

OiO 

segment; 
ooo 

segment; 

000 

segment; 

000 

segment; 

ooo 
segment; 

ooo 
segment; 

000 

segment; 

000 

segment; 

098 

segment; 

000 

segment; 

ooo 
segment; 

ooo 

segment; 

000 

segment; 

ooo 
segment; 

ooo 
segment; 



DISK 
16710 
16720 
16730 
16800 

DISK 
16810 
16820 
16830 
16900 

DISK 
17000 

DISK 
17100 

DISK 
17200 

DISK 
17300 

DISK 
17400 

DISK 
17500 

DISK 
17600 

DISK 
17700 

DISK 
17800 

DISK 
17900 

DISK 
18000 

DISK 
18100 

DISK 
18200 

DISK 
18300 

DISK 
18400 

DISK 
18500 

DISK 
18600 

DISK 
18700 

DISK 
18800 

DISK 
18900 

DISK 
19000 

DISK 
19100 

DISK 
19200 

DISK 



ADDRESS * 
T 0000*0 

T 0000*0 
T OQOO'O 
T 0000*0 
ADDRESS * 
T 0000*0 
T 0000*0 
T 0000*0 
T 0000*0 
ADDRESS m 
T 0000*0 
ADDRESS » 
T 0000*0 
ADDRESS » 
T 0000*0 
ADDRESS » 
T 0000*0 

ADDRESS ■ 
T 0000*0 
ADDRESS * 
T 0000*0 
ADDRESS * 
T 0000*0 
ADDRESS » 
T 0000*0 
ADDRESS * 
T 0000*0 
ADDRESS * 

T 0000*0 
ADDRESS = 
T 0000*0 
ADDRESS = 
T 0000*0 

ADDRESS a 
T 0000*0 
ADDRESS ■ 
T 0000*0 
ADORESS m 
T 0000*0 
ADDRESS a 
T 0000*0 
ADDRESS * 
T 0000*0 
ADDRESS ■ 
T 0000*0 
ADDRESS * 
T 0000*0 
ADDRESS * 
T 0000*0 
ADDRESS ■ 
T 0000*0 
ADDRESS m 
T 0000*0 
ADDRESS m 
T 0000*0 
ADDRESS ■ 



00005 



00005 



00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 
00005 



• 



• 



c 



• 



• 



PROCEDURE CFXP ) FORWARD; % 100 
PROCEDURE DLOG ) FORWARD; % 101 
PROCEDURE CLOG ; FORWARD; % 102 
PROCEDURE ALOGIO; FORWARD; % 103 
PROCEDURE DLOGIO; FORWARD; % 1 0/4 
PROCEDURE OSIN ; FORWARD; X 105 
PROCEDURE CSIN ; FORWARD; * 106 
PROCEDURE DCOS ; FORWARD/ % 107 
PROCEDURE CCOS ; FORWARD; % HO 
PROCEDURE TANF ) FORWARD; % m 
PROCEDURE COTAN ; FORWARD; % 112 
PROCEDURE DATAN ) FORWARD; % 113 
PROCEDURE ATAN2 ; FORWARD; % 114 
PROCEDURE DATAN2* FORWARD; % 115 
PROCEDURE ARSIn ; FORWARD; % 116 
PROCEDURE ARCOS '> FORWARD; % 117 
PROCEDURE SINH ; FORWARD; % 120 
PROCEDURE COSH ; FORWARD; % 121 
PROCEDURE TANH ; FORWARD; % 122 
PROCEDURE DSQRT ; FORWARD; % 123 
PROCEDURE CSORT ; FORWARD; % 124 
PROCEDURE ERF ; FORWARD; % 125 
PROCEDURE GAMMA ; FORWARD; % 126 
PROCEDURE ALGAMA; FORWARD; % 127 
PROCEDURE ANDI ; FORWARD; I 130 
PROCEDURE QRI ; FORWARD; % 131 
PROCEDURE CMPL ; FORWARD; % 132 
PROCEDURE EOUIVP; FORWARD; % 133 
PROCEDURE F0RTERR;F0RWARD; % 134 



?» H 



00019300 T 0000*0 
START OF REL SEGMENT? DISK ADDRESS « OOOO5 

00019400 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS * 00005 

00019500 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS » 00005 

00019600 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS ■ 00005 

00019700 T OOOQIO 
START OF REL SEGMENT; DISK ADDRESS ■ 00005 

00019800 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS » 00005 

00019900 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00005 

00020000 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00005 

00020100 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS « 00005 

00020200 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS ■ 00005 

00020300 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00005 

00020400 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS * 00005 

00020500 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00005 

00020600 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS ■ 00005 

06620700 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS * 00005 

00020800 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00005 

00020900 T 0000*0 
START OF REL SEGMENT) OlSK ADDRESS s OOOO5 

00021000 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS * 00005 

00021100 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS * 00005 

00021200 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS * 00005 

00021300 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS 4 00005 

00021400 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS * 00005 

00021500 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS » 00005 

00021600 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS ■ 00005 

00021700 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS a 00005 

00021800 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS = 00005 

00Q21900 T 0000*0 
START OF REL SEGMENT) DISK ADORESS - 00005 

00022000 T 0000*0 
START OF REL SEGMENT) DISK ADDRESS « 00005 

00022010 T 0000*0 



I 

i 
i 

f 
i 
i 



# 

• 

• 



• 






PROCEDURE MAX! FORWARD? * 135 

PROCEDURE MIN; FORWARD; % 136 

PROCEDURE IMOD? FORWARD? % 137 

PROCEDURE CONCAT? FORWARD? % 1*0 

PROCEDURE C8NCAT; 

FORWARD?* CQDE=08400000» INTRINSIC NUMBER*Pl40 
PROCEDURE MATRIXDIDDLERCA* B* C* TYPE)? 

VALUE A* B* C, TYPE? 
ARRAY A[*3* Bf*3* C t * 3 1 
INTEGER TYPE? 

FORWARD?* CODE=08800000* INTRINSIC NUM8ERs§*4* 
PROCEDURE JNVERTCA, B)? 

VALUE A* B? 
ARRAY A C * 3 * Bt*3? 

FORWARD?* CODE=09100000, INTRINSIC NUMBER=0i42 
PROCEDURE TRANSPOSECA* B)? 

VALUE A* B? 
ARRAY AC*3* St*]? 

FORWARD;* CODE = 08900000» INTRINSIC NUMBERsPi43 
PROCEDURE MATRIXMULTIPLY(A* B» C)J 

VALUE A* B* C? 

ARRAY At*]* BC*3* C[*3? 

FORWARD?* CODE*09000000» INTRINSIC NUM8ER=@t44 
PROCEDURE RANDOM(NUMBER* BASE)? 

VALUE NUMBER? 
PEAL NUMBER? 
INTEGER BASE? 

FORWARD?* CODE=000229GO, INTRINSIC NUMBER*Pl45 
PROCEDURE FORTRANFREEREAD? 

FORWARD?* C0DE=09200000> INTRINSIC NUMBER=Pl*6 
PROCEDURE BASiCLOSECFILX); 



START OF 
START OF 
START OF 
START OF 
START OF 
START OF 

START OF REL 



START OF REL 



START OF REL 



START OF REL 



START OF REL 



START OF 
START OF 



VALUE FILX? NAME FILX? 

BEGIN REAL SELECT=14* ALGOLWRl TE* 12? ARRAY AIT*6[*j; 
REAL T*I? ARRAY FIBCO? NAMf M=2? 
SUBROUTINE MAYBEPRINT* 
BEGIN FlBS*FILXtNOT 2]* 

IF FIBE53,U1I3]"0 THEN *NQT CLOSED-NOT INPUT 
IF FZBC43 . C8S43 NEQ 10 THEN *N0T DATA COM 
IF FIB[203, [3*153/0 THEN * DATA LEFT 

P(MKS,l*0*0*(FI8C203.tl8M03+l)»FlLX#ALGOLWRITE)? 
END? 

IF P(.FILX*LOD)=0 THEN *EOJ FILE CLOSE 

BEGIN I:=AITC03 + 1? WHILE (T : » A IT [ I» = 1-13 ) . [8 : 10 3 NEQ 
DO IF T , C 1 S 1 3 THEN 



REL SEGMENT? DISK 
00022011 

REL SEGMENT? DISK 
00022012 

REL SEGMENT? DISK 
0OQ22013 

REL SEGMENT? DISK 
00022014 

REL SEGMENT? DISK 
00022020 

REL SEGMENT? DISK 
00022025 
00022030 
SEGMENT? DISK 
00022032 
00022034 

00022036 
00822038 
00022040 

SEGMENT? DISK 
00022050 
00022060 
00022070 
00(822080 

SEGMENT? DISK 
00022090 
00022100 
00022110 
00022120 

SEGMENT? DISK 
00022130 
00022140 
00022150 
00022160 

SEGMENT? DISK 
00022162 

00022164 
00022166 
00022168 
00022170 

REL SEGMENT? DISK 
00022175 
00022180 

REL SEGMENT? DISK 
00022185 
00022190 

00022195 
00022200 
00022205 
00022210 
00022212 
00022215 
00022220 
00022225 
00022230 
00022235 
00022240 



ADDRESS « 
T 0000*0 

ADDRESS * 
T 0000*0 
ADDRESS = 
T 0000*0 
ADDRESS » 
T 0000*0 
ADDRESS - 
T 0000*0 
ADDRESS * 
T 0000*0 
T 0000*0 
ADDRESS ■ 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
ADDRESS * 
T 0000*0 
T 0000*0 
T 0000*0 
T 0000*0 
ADDRESS a 
T 0000*0 
T 0000*0 
T 0000*0 
T 0000*0 
ADDRESS * 
T 0000*0 
T 0000*0 
T 0000*0 
T 0000*0 
ADDRESS * 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
ADDRESS » 
T 0000*0 
T 0000*0 
ADDRESS 9 



0000*0 
0000*0 
0000*0 
0000*0 
0001*0 

0002*3 
000^*1 

0006*1 
0008*1 
0011*3 
0012*0 
0013*3 
0018't 



00005 
00005 
00005 
00005 
00005 
00005 

00005 



# 



00005 



00005 



• 
• 

• 
* 



00005 



00005 



00005 
00005 



• 
• 



€ 



• 



BEGIN FILX*«MtMCT.tl8«133] INX 43; MAYBEPRINT END; 
END ELSE %FILE RESTORE 
BEGIN MAYBEPRINT; 

PcMKS,2,0,CFILX[NOT 2 3 3 , 4, SELECT ) ; 

FIBCO] »»FIBC8]i»FIBC20]i»FIB[213I-0; 

end; 
end basic file restore; 



00022245 T 
00022250 T 
00022255 T 



00022260 
00022265 
00022270 
00022275 



0020*0 
0025*2 
0025*2 
002750 
0029*1 
0033*2 
0033*2 



SIZE* 0034 WORDS 



• 



• 
• 



PROCEDURE FILEATTRIBUTES(T#E#D»V>G#I#TN)J VALUE T#I*V#D,G; REAL D#G#I#E; 00022280 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS-* 00007 

INTEGER V; ARRAY TNt*]; NAME It FORWARD; % CODE 9 0043000* INT # 9150 00022281 T 0000*0 

PROCEDURE COBOLDECIMALTOOCTALCONVERT(A); % INT #**15l» C0DE*0930000Q 00022282 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS * 00007 

VALUE A; NAME a; FORWARD ; 00022283 T 0000*0 

PROCEDURE C0B0lOCTOLTODECIMALCONVERTCA»l>H#R»N#S,T5; * INT #«?152 00022284 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS n 00007 

VALUE L,H,R,N,S*T; REAL L>H,R»N*S*T; NAME A; FORWARD; % C0DE*0940Q000 00022285 T 0000*0 

PROCEDURE FORTRANFRE£wRlTECF,D,R*W*L*I>N>S); VALUE I»D,R#W>l; INTEGER R# 00022286 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS ■ 00007 

W; REAL I#D,L; NAME F; ARRAY S[*3,N[*3; FORWARD ;%COD t?0297$Q19,INm33 00022287 T 0000*0 

PROCEDURE FINNAME; FORWARD; 06022288 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS * 00007 

PROCEDURE FOUTNAME; FORWARD; 00022289 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS s OOOO7 

PROCEDURE FTINTFIX(F1,01>F2,F3,L1>E1*E2,P1 ); VALUE Dl *F2# Ll# El, E2,Pl ; 00022292 T 0000*0 

dvy%00&0 START OF REL SEGMENT; DISK ADDRESS ■ 00007 

REAL Dl,F2/Ll>El>E2>Pi; ARRAY F3C*3; NAME Fi; FORWARD; % INTRINSIC P156 00022293 T 0000*0 

PROCEDURE FT0UTFIX(F*D>R>Q*L>E>EL,PL); VALUE D*R*L#E»EL»PU REAL D'R>L,E 00022294 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS * 00007 

»EL*PL; NAME F; ARRAY QC*]; FORWARD ; % CODE AT SEQ * 02886040, INTP157 00022295 T 0000*0 

PROCEDURE FBINSACKBL0CKCF1,D,F2,F3,L»E1,E2*P1); VALUE D,F2,L,E1 *E2,Pi ; 00022296 T 0000*0 

fl-inCeltrt START OF REL SEGMENT; DISK ADDRESS * 00007 

REAL D>F2,L,E1,E2,P1' ARRAY F3C*]I NAME FU FORWARD; % INT # 9160, 00022297 T 0000*0 

PROCEDURE COBCLVARSZ; FORWARDS CODE-09500000 INT #»*16l 00022298 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS m 00007 

PROCEDURE COBOlIONONDSK; FORWARD;* CODE=09600000 INT #sS>162 00022299 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS « ©0007 

PROCEDURE C080LI0DSK; FORWARD^ CQDE*09700000 INT #=@163 00022300 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS * 00007 

proceoure fortranmemnandler(a,h);value h;real h;array At*];FORWARo;a;i64 00022301 t 0000*0 

START OF REL SEGMENT; DISK ADDRESS ■ 00007 

procedure cqbolatt; forward; % code = 02650000 int # * 0165 «cjc 1031 00022302 t 0000*0 

start of rel segment; disk address n 00007 

00022303 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00007 

00022304 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS » 00007 

£0036 00022310 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS a 00007 

00022320 T 0000*0 

00022330 T 0000*0 

00022340 T 0000*0 



PROCEDURE INTERRUPTER; FORWARD; % CQ0E=098000O0; INT #-§166 

PROCEDURE COBOLDC; FORWARD; % CODE » 02690000 INT #«?167 

INTEGER PROCEDURE DELT ACP 1 , P2 > ; VALUE pl#P2J REAL Pi*P2; 

BEGIN 

DEFINE 

D0T*[18ll3J#j. AMPER=[18*35U33#; 



COMMENT 04000000=2*20, WHICH IS 1 LARGER THAN ANY 6500 COUNT.; 



00022350 T 0000*0 



» * 



* » 



end 



COMMENT DEi-TA = 2*20 IF DESC C PI ) XDESC CP2 ) OR CSIZE-S ARE 
IF (P2-P1). [31H73XO THEN DELTa*04OOOOOO ELSE 

delTa«-p2, dot-pi, dot; 
delta; 



0®022360 T 0000*0 
00022370 T 0000*0 
00022380 T 0003*1 
00022390 T 0007*1 

SIZE* 0008 WORDS 



PROCEDURE ICVD; 



%37 



BEGIN 



DEFINE 00T=E18U3]#, AMP£R= C 18 l 35? 1 3 3#* CS IZE* C 31 1 02 ]#* S IX*0#; 

ARRAY STRINQC*]; 

NAME M = 2* 

«EAL PTR=-3/ INTEGER N=-i; 

IF PTR.CSIZEXSIX THEN POL ISH( M&l C 17H7 I 13 > 9999* CDC* DEL > i 

STRING <• MCPTR3; 

N<-N; COMMENT MAKE SURE N IS INTEGERIZED; 

IF N>8 THEN PQLISHC M&l [ H ! 47 »0i 3 , N* CDC* DEL ) i 

POLI SHC [STRING CfPTR,DOT+N-l),[ 35: 103 3 3* DEL)! 

STREAM(RESULT«-0»S«-[STRlNGCPTR.Cl8U0n]# N, 

SKS«-PTR,C28;033); 
BEGIN 

di «■ loc result; 
si * s; si ♦ si+sks; 
ds «■ n Oct; 
end; 

ptr ♦ p; 



END ICVDJ 





00022400 


T 


0000*0 




00922500 


T 


0000*0 


START OF REL 


segment; disk 


ADORESS * 




00022510 


T 


0000*0 


#*sixbo#; 


00022520 


T 


0000*0 




00022530 


T 


0000*0 




00022540 


T 


0000*0 




00022550 


T 


0000*0 


EL) J 


00022560 


T 


0000*0 




00022570 


T 


000^*0 




00022575 


T 


0005*2 




00022580 


T 


0006*1 




00022590 


T 


0009*2 




00022600 


T 


0012*1 




00022610 


T 


00H*1 




00022620 


T 


0015*1 




00022630 


T 


0015*1 




00022640 


T 


0015*2 




00022650 


T 


0016*1 




00022660 


T 


0016*3 




00022670 


T 


0017*0 




00022680 


T 


0017*2 




SIZE= 0019 



00008 



WORDS 






PROCEDURE DYNAMICDIALERCA,B»X*F) ; 

VALUE B, A, X* FJ 

INTEGER B* A* X; BOOLEAN F; 

BEGIN % A,B>X>Y>Z ARE AS IN Y&Z[A$B*X3. 
X F=TRUE => X WAS LITERAL* AND TRB 

REAL Y=-7# Z = -6» C=+l * 

DEFINE 0= ?>3403007777777777 t 



ENO 



START OF REL 



WILL BE DONE AFTER XITING 



Rs P0055005500610065 ## 
S* ©0055703«0a2l0435 *; 



IF 
IF 



% MASK FOR ZERO-ING OUT THE G'H'K&V 

% REGISTER PARTS OF THE RCW, 

% NOP»DIA>DIB*TRB, 

% N0P*LITC Y*STD*XIT, 



(X*X)<1 OR X+A>48 OR X+B>48 




00022700 

segment; DISK 

00022705 
00022710 
00022715 
08022720 
00022725 
00022730 
00022735 

00022740 
00022745 
00022750 
00022755 
00022760 
00022765 
00022770 
00022775 
00022830 



T 0000*0 
ADDRESS m 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0006*2 
0008*3 
0013*0 
0016*3 
0020*1 
0025*2 



00009 



SIZE* 0029 WORDS 



PROCEDURE RANDOM(NUMBER# BASE)* 

VALUE NUMBERS 
REAL NUMBER' 
INTEGER BASE* 
BEGIN INTEGER N/* 

REAL Ti 

IF CT := NUMBER 

BEGIN BASE * = T, 

IF NUMBERS THEN 

BEGIN T := POLISHCIj. 1* COM); 

N * = & TC10:36S63 & T[16'42'6] & T[22«30*6] 
& CCT,[30*18])xPcDUP)H28»22i20j; 

END ELSE IF CN * = BASE)=0 THEN N := P263135302000Q; 

T J= 3 * CN,ClO'26]x6137 + 2 19/51 3 ) [ 10 * 12* 36 3 1 

P0LISH((C(BASE !« T) OR 0.5) - 0,5) + PCDUP)> RTN)I 
END RANDOM; 



MOO 1.0)>0 THEN 
[9*383; PCRTN); 



end; 



00022840 T 0000*0 

00022850 T 0000*0 

00022900 T 0000*0 

START OF REL SEGMENT) DISK ADDRESS ■ 00010 

00022925 T 0000*0 

00022950 T 0000*0 

00022975 T 0000*0 

00023000 T 0000*0 

00023025 T 0000*0 

00023100 T 0000*0 

00023150 T 000211 

00023200 T 0004*2 

00023250 T 0005*1 

00023300 T 000710 

00023350 T 0009*2 

00023400 T 0012*3 

00023450 T 0017*2 

00023500 T 0020*3 

00023550 T 0023*2 

SIZE* 0028 WORDS 



00023600 T 0000*0 



PROCEDURE SWAP, 
BEGIN 



% 045 



START OF REL 



ARRAY A a -2 
STREAMCA* 8* 



1***1* B '»■- 
CA*-0# CB*0> 



■1 c***3; 

FA«-A, [18*153* 



FB«-B,(18I15]}; 



BEGIN 



SI 

SI 

DI 
SI 
3(IF 

DI «■ 
01 ♦ 
SI ♦ 
3CIF 
DI *■ 



a; ca * si; 
b; cb * si; 

loc b; di * Di+s; skip 3 ds; 
loc ca; si ♦ sr+s; skip 3 sb; 

SB THEN DS *■ SET ELSE DS «• RESET; 

fb; si <- loc e; ds <■ wds; 
loc a; di «• di+s; skip 3 db; 
loc cb; si «- si+5; skip 3 sb; 

SB THEN OS <- SET ELSE DS + RESET; 

fa; si «- loc a; os * nds; 



skip SB); ds *■ 2 chr; 



skip sb); ds * 2 chr; 



END 



end; 
swap; 



00023700 

segment; disk 

00023710 
00023720 
00023730 
00023740 
00023750 
00023760 
00023770 
00023780 
00023790 
00023800 
00023810 
00023820 
00023830 
00023840 

00023850 
00023860 



T 0000*0 

address ■* 



00011 



• 

• 
# 



0000*0 
ooooso 
0000*0 

0004*0 
0004*0 
0004*2 
0005*0 
0005*3 
0006*2 
0008*3 
0009*2 
0010*1 
0011*0 
0013*1 
0014*0 
0014*1 



SIZE* 0015 WORDS 



COMMENT ALGOL WRITE INTRINSIC;* 
PROCEDURE ALGOLWRITECTEN* FILX* CHSKP, 



LNSKP* FI* AEXP* 



START 



VALUE 



ARRY* LlNESKIP* CHANSKIP* 
LINESKIP* CHANSKIP* SUPR5, 



SUPRS* NUMWDS* TANK); 
NUMWDS* TANK* 



%WF 

OF REL 
*WF 
*WF 



00023900 
00024000 
00024100 
00024200 
00100000 
00100100 

segment; oisk 

00100200 
00100300 



0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
address ■ 

T 0000*0 
T 0000*0 



00012 



I 



INTEGER 

NAME 
ARRAY 

BEGIN REAL 
NAME 



chskp* lnskp* fi* arry; 
chskp* lnskp, fi* aexp* 

LlNESKlP* CHANSKIP* NUMWDS* 

filx* Tank; 

ARRYt*], TENC*]| 
SELECT =1 4 *REED=1 3* ADDRESS; X 
MEM=2/% 



suprs; 



• 
• 

• 

• 



36* COM, DEL* DEL); 






LABEL AB, ACTION? 

LABEL DS,WINDUPl) 

ARRAY FPRs3t*3»FlB[*],HEAOERt*];x 

integer i*rsize;% 
integer spout; 
array tink=tankc*]; 

REAL CHNSKPoCHANSKlP; 
REAL ALG0LWRITE=12; 
DEFINE FNUM = F IB[ 43 . C 1 3 I 1 1 3 *i 
DEFINE IOD=(*TANK)#;% 

, $ SET OMIT = NUT(TIMESHARING) 

f — H I SUBROUTINE WAIT; PQLlSMCTANK* 02OOOOOOOOO* 
$ POP OMIT 
$ SET OMIT s TIMESHARING 

LABEL ERR* LP1 > Mt 1 > CLOSED' OK l*SPl*cPl' DC l'PPi;* 
LABEL DCN1*DCN2*SPIN; 
$ SET OMIT « NOT SHAREDIS* 

SWITCH SWl* ERR*LPt*MTl*CLOSED*DKl*sPl*CPl#LPl*PPl*ERR*DCl* 

err*lpi*dcni; 
label lp2*mt2*dk2'sp2*cp2*dc2*pp2;% 
switch sw2<- err*lp2*mt2*err*dk2*sp2,cp2*lp2*pp2*err*dc2*err* 

LP2*DCN2* 
LABEL DSl»ORl#OUi;% 
SWITCH DSWl*0St»0Rl*OUl*CL0SED; 

label ut»pbit*Qwt*di9*release*sta,exit*li*windup*dbit;* 

LABEL TYPEU*TYPEA»TYPEC;« 

switch type*typeu»typea*erR*typec;% 
label qs2*dr2*du2;% 

r ^~ -^ switch dsw2*ds2*0R2*du2;% 

Subroutine blccku 
begin go to t y&e t i *f i b c 5 3 , c 46 % 2 3 3 ; * 
typecv streamcd1*i00#s*<numwds*numw0s+1)x8*% 

U2*(TANKL0]*NUMHDS INX lQD)m 

begin si^uac s; oi*di-8; ds+4 dec; DUDliX 

SI*D2; SUSI-8J DI*DI-4; DS«-4 CHR;% 
EN01% 
IF (FlBCl73*FIB(17J-NUMWDS)>R5lZ£ + i THEN BEGIN* 
OWT! / FI8C73*FIBC73+1; P(XIT);* 

TYPEAJ/ IF (FIBC17]*FIBC173-RSIZE)iRSIZE THEN* 

BEGLN TANKC03«-RSIZE IMX IOD; GO OWT END END;* 

NUMWDS4.FlBCTflT7[TBTl5]-FIBCl^ + (I»3);i "~ 
JYPEUS^ND BLOCKS 

REAL SUBROUTINE DI SKAODRESS; % 
BEGIN* 

ADDRESS«-(CHANSKIP DIV HE ADER 1 3 ♦ t 30 J 1 2 3 ) xHE A0ERCO 3 , £42 8 6 3 ; I 
IF (SUPRS«-AODRESS DIV HE ADERC13+ 10) >30 THEN 

BEGIN P(0); GO TO EXIT END* 
IF HEADER£SUPRS3=0 THEN 
IF HEA0LR[93>(SUPRS-10) THEN* 

PCFP8CFNUM+3 3*FP8CFNUM3*FPBCFNUM+13»SUPRS,HEADER* 



%WF 


00100400 


T 


0000*0 


%WF 


00100500 


T 


0000*0 


XWF 


00100600 


T 


0000*0 


XWF 


00100700 


T 


0000*0 


%WF 


00100800 


T 


0000*0 




00100900 


T 


0000*0 




00101000 


T 


0000*0 




00101100 


T 


0000*0 




00101200 


T 


0000*0 




00101300 


T 


0000*0 




00101400 


T 


0000*0 




00101450 


T 


0000*0 


%WF 


00101500 


T 


0000*0 




00101550 


T 


0000*0 


*WF 


00101600 


T 


0000*0 




00101650 


T 


0000*0 




00101700 


T 


0000*0 




0S101750 


T 


0000*0 




00101752 


T 


0000*0 




00101753 


T 


0004*0 




00101799 


T 


0004*0 




00101900 


T 


0004 JO 




00101910 


T 


0004*0 




00101919 


T 


0004*0 




00102000 


T 


0004*0 




00102010 


T 


0004*0 




00102100 


T 


0004*0 




00102200 


T 


0004*0 




00102210 


T 


0004*0 




00102300 


T 


0004*0 




00102400 


T 


0004*0 




00102500 


T 


000410 




00102600 


T 


0004*0 




00102700 


«*> 


000«*0 




00102800 


T 


0004*0 




00102900 


T 


0004*0 




00103000 


T 


0004*0 




00103100 


T 


0004*0 




00103200 


T 


0008*1 




00103300 


T 


0010*3 




00103400 


T 


0012*2 




00103500 


T 


0013*2 




00103600 


T 


0014*2 




00103700 


T 


0014*3 




00103800 


T 


0018*1 




00103900 


T 


0020*2 




00104000 


T 


0023*0 




00104100 


T 


0025*2 




00104200 


T 


0029*0 




00104300 


T 


0029*1 




00104400 


T 


003010 


3**% 


00104500 


T 


0030*0 




00104600 


T 


0033*1 




00104700 


T 


0035*3 




00104800 


T 


0037*0 




00104900 


T 


0038*0 




00105000 


T 


0040*0 



n 



4*11* COM, DEL* DEL* DEL* DEL* DEL* DEL) ELSE 
BEGIN P(O); GO TO EXIT END;* 

aodress«-headefusuprs:i+suprs«-address mod headerc u j% 
stream(d«-t address]); begin si*d* ds*8 dec end; pc 1 );% 

exit? diskaddress*p;% 

end diskaddress;x 

ip tink=o then 

BEGIN FIB «- FlLXtNOT 23; 

IF FI6t53.Cli;23<2 THEN P( MKS* M WRITNG M *FILX*7 *SELECT ) 
IF FIBC53. [43*13 THEN 

P(MKS, CHSKP, 0* FlLX* 1* SELECT); 
IF LNSKP>1 AND ARRY<0 AND C I<-F IBC 43 . [8 $ 4] )/ 1 
$ SET OMIT = NOTCTIMESHARING) 

ANO 1/7 AND 1/12 AND 1/10 THEN 
$ SET OMIT * TIMESHARING 

PCXITmCARRIAGE CONTROL ON NON-PRINTER FILE 



XWF 
XWF 



RSlZE *■ P(MKS 



• 
• 



IF ARRY< 
BEGIN X 
IF 
P 
EL 
IF 

T 
IF 
STR 

BEG 

END 

end; 

IF RSIZE 

CMSKP, 

FlLXtNOT 

pcxit); 



THE 
11/ 
ARRY. 
(DEL, 
SE % 

P GTR 

HEN P 

PCDUP 
EAMCP 

IN SI 

P2C 



, LNSKP, CHSKP* SUPRS* 

(-1), FlLX* ALGOLWRITE); 

N SUPRS * 1 ELSE 

24/72 - CORRECTED 10/3/73 

[8*103=PCDUP*0) THEN * INDEXED MR I 

AEXP) % WRITE MIN(AEXP*RSIZE) WORD 

WRITE MiNCARRY SI ZE* AEXP*RSIZE ) WO 

P(DUP*AEXP) % 
(DEL*AEXP); 

)>RSIZE THEN PCDEL) ELSE RSIZE * P 
4 * CARRY [OJ] # P3 * RSIZE* 

P2 «■ P(DUP), [36*63* PI * *FILX); 

<- pa; os * P3 wds; 
ds «• 32 wds; ds * 32 WQS); 



XWF 
XWF 
XWF 



TE 

S 
RDS 



>0 THEN PCMKS* 
SUPRS* RSlZp* 
4] * FILXCNOT 



LNSKP* 

FlLX* ALGOLWRITE); 

33 «• o; 



UTJ 



LPU 
% 

D19* 
PBIT: 



FjB<-T 
I«-FIB 

SPOUT 

SET OMIT 

IF CH 

BEGIN 

SET OMIT 

end; 

IF NU 
MTli 



end; 

ANKCNOT 
C 4 3 . C 8 ; 
;«s(I*5) 

a TIME 

NSKP.C4 

CHNSKP 

■ NOT 



%WF 
XWF 
XWF 
XWF 
XWF 
XWF 
XWF 
XWF 
XWF 
XWF 
XWF 
XWF 
XWF 



n 1 » w 

43; RSIZE«-FIBC183,C33»153;X 

* 

SHARING 

111 THEN 

,C4si3«-o; 

SHAREDISK 



MWDS<0 THEN GO TO SWlClll GO TO SW2CI]** 
SPU CPU FPU 



IF 
IF 
IF 
CLOSED* 



10 

10 

10 



0.C19U 

D.C2M 3 

D.C25*1 

BEGIN 

F 

I 

A 



3 THENX 

THEN PCRSIZE*RTN) 
3 THENX 



ELSEX 



IBtl33, [27*13*0; 

F Cl*CFPB[FNUM+33 AND 31)3/10 AND 1/12 

ND 1/13 AND 1/26 THEN FIBC5 3 , C 45 * 1 3 «-0 ELSE 



00105050 
00105100 
00105200 
00105300 
00105400 
00105500 
00105600 
00105700 
00105703 
Otl05710 
00105720 
00105750 

00105752 
00105753 
00105754 
00105760 
00105800 
00105900 
00106000 
00106100 
00J06200 
00106300 
00106320 
00106340 
00106360 

00106380 
00106400 
00106500 
00106600 
00106700 
00106800 
00106900 
00107000 
00107100 
00107200 
00107300 
00107400 
00107500 
00107600 
00107700 
00107800 
00107820 
00107840 
00107860 
00107870 
00107879 
00107890 
00107900 
00108000 
00108100 
00108200 
00108300 
00108400 
00108410 
00108420 
00108430 
00108440 



004610 
0048»1 
0049*2 
0052U 
0054*0 
00541 1 
0054*2 
0057*2 
0059*3 
0063*0 
0064*0 
0066*0 

0069*2 
0069*2 
0073*1 
0073*1 
0074*0 
0074*0 
0074*0 
0075*0 

0076*2 
0078*3 
0081*0 
0082*3 
0083*3 

0083*3 
0084*3 
0086*0 

0088*2 
0089*2 

0091*0 
0091*3 
0093*0 
0093*1 
0093*1 

0095*0 
0096*1 
0099*2 
0099*3 
0099*3 
0101*2 
0104*2 
0105*3 
0105*3 
0106*2 
0108*3 
0108*3 
0108*3 
0126*0 
0126*0 
0126*0 
0127*0 
0129*2 
0131*0 
0131*2 
0134*0 
0137*2 



» *» 



* «• 



• 



ERR' 
OS? 



OKI 
DK2 
CP2 

LP2: 



SP2! 
MT2S 




IF 



END 
IOO. C27 
BEGI 



FIBC5J 
PCTANK 

IF NOT 
PCTANK 
PCMKS, 

pen; 

ELSE 
U] AND 
N IF NO 



.U5sn*P(TANKCN0T 3}*DUP)X0 AND PCXCHmS* 
#0,H#cOM*DEL>DEL> ) 

Fi8[5].[45Ji3 then go ut ; 
cnot 3])/ tankcmot 33*tankcn0t 43*0 ) 
9/blkcntrl/del) ',% take parity action lbl brnch, 
go to ds; 

Cl«2 OR 1-7 OR 1=8) THEN* 
T FIB[45.C2H] THEN* 

BEGIN HEADER^-TANKtNOT 1] ) HEADER C 4] , C 42 I 6 ] *i END/ 
7 THEN FIBt93,Clil]*lJ X MULTI-REEL PBT FILE 
[133.[28»103+i;% 

/6/0/CNOT 2) INX TANK, 4, SELECT))* 
3].[28*103«-i; GO TO CLOSED** 



END 
BEGI 



IF 1 = 

I*FIB 
PCMKS 

FlBri 
ELSE* 

N 

p(3); 

P(TANK#XCH,11*CQM); 



RELE 
WIND 



WAI 

HEA 

HEA 

BLO 

IF 

CHA 

IF 

BEG 

END 
TAN 

GO 
PPgj 

BLO 
P(T 
9 
IF 



ASEJ 

UP* 



WI 



duu 

DSi: 



END/ 
T) GO T 
DER**tF 
DER**[F 
CK) TAN 
SUPRS T 

NSKlP*C 

CHANSKI 

IN IF ( 

STRE 

ELSE B 

KC03«-FL 

&C 

TO RELE 

% 

CK',% 
ANK[03«- 
3700000 

spoui 

pg [ 

PC0,0,N 

ELSE 
PCFL 
l+F.l 
FT.BI 
FIBC 

NDUP1 J 
FlBt 
PCXI 



PBIT 
IBC14] 
IBC14] 
KC03+F 
HEN ST 
HANSKI 
P*0 TH 
I*FIBt 
AM( I#D 
LOCK/* 
AGCFIB 
HANSKI 
ASE/X 



}% 

3) GO TO DSwltFlBC43,C27*333JX 

]> GO TO 0SW2[FIB[4].E27S333;* 

LAGCFIBC163 HCH ANSKIP C 32 J 47il 3 / GO TO RELEASE!* 

REAM(RSlZE»D«-IOD); BEGIN RSIZECDS«-8 LIT " "} END) 

P+LINESKIP.C45S13; 

EN* 

173-RSIZE)>0 THEN* 

*RSIZE INX IOD); BEGIN I(DS«-8 LIT » ") END)* 

Cl6])&LINESKlPC27i47ll3*LINESKlPt28U6liJ.X 
P[29I4AI4]*NUMWDS[8I38110];X 



FLAGCFlBCl6 3)fiiNuMWDSC8t 38»10 3#NUMWDS/XCH* INX/* 
000000000, XCH,*)/* 

EN * SPO OUTPUT 
FNUM+33»C42$63*43 THEN P(XIT) ELSE XDUMMY 
OT»I0D#INX#15»C0M,XIT) 

AG(FlBtl93 3&IODC3!3J53/TANK#PRL#DEL))* 
BC193, [33*153 -FIB[163,C33*153)X 

163,£33Jl53«-SUPRS*MEMtP(0UP) INX NOT 13, [18:153/* 
19].C33H5]*SUPRS + IIX 

6]*FIBC63 + 1; FIBt73«-FI8[7] + i; FIB[ 17 3*FIB[ 18 3 f [ 18 i 15 3 IX 
T);* 



IF LINESKIP^O THEN* 
BEGIN IF IOD.C27813 AND I0D.U9H] THEN 
IF FlB[l73=FIBC183.tl8J153 THEN 
BEGIN CHAN5KIP*FIBC7];% 
Ll S IF OISKAODRESS THEN* 

IF I0D.C19U3 THEN DBlT* IF 
BEGIN 
* SET OMIT = NOT SHAREDISK 

MEW[FIBC1633*-ADDRESS; 



GO AB/ 



IQ0,C2*13 THEN* 



00108450 
00108510 

00108515 
00108520 
00108525 
00108530 
00108535 
00108600 
00108700 
00108800 
00108850 
00108900 
00109000 
00109100 
00109200 

00109300 
00109310 
00109320 
00109330 
00109400 
00109500 
00109600 
00109700 
00109800 
00109850 
00109900 
00110000 
00110100 
00110200 
00110300 
00110400 
00110500 
00110600 
00110700 
00110800 
00110900 
00110910 
00110920 
00110940 
00110990 
00111000 
OOllilOO 
00111200 
00111300 
001H400 
00111500 
00111600 
00111700 
00111800 
00111900 
00111950 
00112000 
00112100 
00112200 
00112300 
00112309 
00112340 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
C 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0143*1 
0149*0 
<H50*2 
015210 

0156«2 
0157*2 

0158*1 

015811 
016213 
0l6ai2 
0169*1 
0173*0 
0175*0 
0177*1 
0180*1 
0180*1 
0180*3 
0181*0 
0182*0 
0182*0 
0183*2 
0188*2 
0193*0 
0196*3 
0201*0 
0202*3 
0203*2 
0206*0 
0210*2 
0212*0 
0214*0 
0217*1 
0217*3 
0217*3 
0219*0 
0222*0 
0222*3 
0223*0 
0227*0 
0231*1 
0231*1 
0234*3 
0237*2 
0242*1 
0244*3 
0244*3 
0251 *0 
0251*1 
0251*1 
0252*0 
0255*2 
0257*2 
0259*0 
0260*0 
0263*0 
0263*2 
0263*2 



• 
• 



• 



mE 



w 



$ SET 



$ SET 



OMIT 
OMIT 



s NOT 



$ SET OMIT s NOT 



END. 



A8i 

go to obit; END ELSE 



ab; 



pcrsize^Rtn); 

END ELSE 

IF IOD. [25*13 THEN GO TO CLOSED ELSE 
= NOT SHAREDISK 
BEGIN 
SHAREDISK 

GO TO 
END ELSE 

begin wait; 

BEGIN 
SHAREDISK 

GO TO 

end; 

p(rsize,rtn);s 
end;% 

P(MKS,GHANSKIP»4»TANK»1, SELECT); gO TO UJ 

if fibc7]>header[7] then header c 7]«-fibc 73 }% 
block; tankco]«-flagcfibci6]); go release;* 
if lineskipxo then chansk ip«-f ib i 7 ] else fib i ? 3 «-chansk ip; % 
if headepm<chanskip then header t 7 3*chanskipi % 
$ set omit ■ not sharedisk 

if firc5].[46j2]=0 then go to liu 
if diskaddress thenx 

BEGIN FIBC163 tC24*13«-l »X 
S SET OMIT = SHAREDISK 

P(MKS#CHANSKIP+l,i»TANK,REED»RTN);% 



DS2 



DR1 



$ POP OMIT 
$ SET OMIT 

end;* 
s set omit 

GO TO 
DR2J 
S SET QMIT 



= NOT SHAREDISK 
a NOT SHAREDISK 

ab; 



NOT SHAREDISK 
TANKC0 3*rLAG(FlBtl6 3 J&OE24J24U3; 
P(FLAGCFIBC19])&I0Ot3l3»534lt27l47«13#TANK*PRL#0Et);X 
$ SET OMIT * NOT SHAREDISK 
GO TO WINDUP;* 
DU2S! FlBt53.U3«Z3*2j!J 

if fib[7]>headerc73 then headerc 7 3<-fibc 73 ; x 
block;* 

CHANSKlP«.FlBC70 + FIBti3),ClOl9]xHEADERtO3.C3Oll23;x 
IF DISKADDRESS THEN* 

BEGIN P(TANKC0]«-FLAGCFlB[l6])40[2flf24ll3#CN0T 0)*XCH*INX» 
ADDRESS, XCH,OIX 
P(FLAG(FlBtl93)&U24U7 5 13*TANK,PRL*DEL);% 
END ELSEX 
BEGIN TANKC03*FLAGCFIBC16 3)&0[24S24?13;% 

PCFLAGCFIBE193)&H24M4SA3»TANK*PRL*DEL)U 
END IX' 

GO TO WINDUPI% 
$ SET OMIT - NOT(TIMESHARING) 
DC1*I P<RSIZE> RTN); 
S SET OMIT = TIMESHARING 

ABJ! BEGIN IF(ADDRESS«-TANKtNOT 43) = THEN GO ERR! 
ACTION:: TANKCNOT 33<-TANKCN0T 43 *0 J 
TANKC03 :* IOO OR MEM; 
p(ADDRESS»MKSf9,JDNK); GO TO ERR; 



00112350 
00112360 

00112400 

00112409 

00112420 

00112429 

00U2440 

00112450 

00112460 

00U2470 

00112479 

00112490 

00112500 
00112600 

00112700 
00112800 
00112900 
00113000 
00113100 
00113200 
00113249 
00113300 
00H3400 
00113500 
00113599 
00113600 
00113601 
00113649 
00113700 
00113749 
00113800 
00113900 
00113909 
00113980 

00114000 
00114049 
00114100 
00114300 
00114400 
00114500 
00114600 

0011*700 
00114800 

00114900 
00115000 
00115100 
00115200 
00115300 
00115*00 
00115500 
00115501 
00115510 
00115590 
00115800 
00115900 
00116000 
00116100 



T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 

T 
T 

T 

T 

T 

T 

T 

T 

T 

T- 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0265*3 
0265*3 
0267*1 
0267*1 
026810 
0268*0 

0268*2 
0268*2 
0270*2 
027110 
0271*0 
027j*2 
027152 
0272*0 
0272*0 
027410 
0277J1 
0279*3 
0283*3 
0286*2 
0286*2 
0288*2 
0290*0 
0293*0 
0293*0 
0295*0 
0295*0 
0295*0 
0295*0 
0295*0 
0295*2 
0295*2 
0295*2 
0297*3 
0301 13 
030 U 3 
0302*1 
0305*2 
0308*3 
0310*0 

0313*2 
0315*0 

0318*3 
0319*2 
322*1 
0322*1 
0325*0 
0327*3 
0327*3 
0328*1 
0328*1 
0329*2 
0329*2 
0332*3 
0336*1 
0337*3 



» «t 



• 4 



IF 

GO 

$ SET OMIT 
DC2S IF 



m 



m 

m 



end; 

if tankcnot 43*0 then begin wait; gd to dc1 end; 

f&(CHANSKIP t [CF]x60,CHANSKlP,TANK,18,ll,C0M»DEUDEUDEL> 

then p(rsize>rtn); 
to ab; 
= nut(timesharing) 

CHaNSkIP.CCFj NEQ THEN CHANSk IP issABSC CHANSKlPU I CTF3 ) 
ELSE CHANSKIP * ( 8x(L I NESK IPs4 3+LINESK IP , [ 45 J 3 3 ) 

&LINESKIPI32I43H]; 
NUMWDS «• IF' SUPRS THEN ELSE 8*NUMWDS; 
P0LISH(I0D# NUMWDS* CHANSKIP, 0* (Ml)i COM, DEL); 
IlsPOLlSH+1' 

ADDRESS JsTANK [ NOT ( 4- (1*2))]; 
TANKCNOT 43!=TANK[NOT 33 * «0/ 
IF I THEN P(XIT); 
IF ADDRESS NEQ THEN 

P( ADDRESS, MKS, 9, 8LKCNTRL); 
ADDRESSS = l + CU*0)x2); 
P(TANK, ADDRESS, 11, COM); 
DCN1 »DCN2*SPIN* P(XIT); 
$ SET OMIT ~ TIMESHARING 

END algolwrtTe; 



00116200 
00116300 
00116400 
00116500 
00116600 
00116601 
00116610 
00116620 
00116630 
00116635 
00116640 
00116644 
00116646 
00116648 
00116650 
00116652 
00116654 
00116656 
00116658 
00116660 
00116690 
00118800 



0339*1 
339* 1 
0343*2 
0346*3 
0347*3 
0348*1 
0348*1 
0350*2 
0353*1 
0355*3 
0358*2 
0360*3 
0361*3 
036^*2 
0367*3 
0368*3 
0369*2 
37 no 
0373*1 
037/»li 

0375*1 
0375*1 



• 
• 



• 



SIZE* 0376 WORDS 



• 



PROCEDURE OUT 
CHMM 
IE 



PUTINTCTEN,FILX,CHSKP,LNSKP,FI,FRMT,LISX);% 
ENT 



START QF REL 



VALUf 

NAME 

ARRA' 



REAL 
INTE 



LISX 
GER 

BEG I 
REAL 
ARRAY REA 

REAL 
PEAL 
INTE 
INTE 
INTE 
INTE 
INTE 
ARRA 
INTE 
REAL 
DEFI 



:ger 
:ger 
:ger 

;GER 

:ger 

,Y 

:ger 



:ne 



CH 
FI 
TE 
FR 

1% 
CH 

H% 
AL 

LRO 
SE 
JU 
V2 
TE 
JU 
LS 
AE 
AR 
TL 
UT 
UT 
FF 
ST 
UE 
UD 
UE 
UM 



ESPOL VERSION OF ALGOL WRITE INTRINSIC* 
BY L.R, 6UCK 12/1/6^;* 

skp*lnskp,fi*lisx;% 
lx;% 

mti*];x 

SKP,LNSKP,Fi;* 



GOLWRI 

w=ten- 

LECTM 
NK2=9J 

-1 ; 

MPD = 7 
NK1«17 
TRN-19 
XP -FR 
RY -LI 
STRN=+ 

YP s T 

IP sUT 
TYPsUT 
ORWsUT 
S *UT 
C =UT 
D =UT 
D -UT 



TE*12;% 

a;% 



1% 

mt;* 
sxc*3; 
1 ;% 

LSTRN+ 
YP.U7 



% 



i; 

513 
13 
63 

113 

13 
*23 
YP.C35S 13 



YPt 

YP, 

YP. 
YP. 
YP. 



[46 
C40 
C39 
C38 
[36: 



#, %%%% USED FOR NON-BOOLEAN USE OF UTYF 

#» %%%% FLAG TO SHOW USing FREE FIELD, 

#, %%%% USED TO STORE ORIG VALUE OF W, 

#, %%%% FLAG TO INCLUOE EXPONENT SIGN. 

#, %%%% FLAG TO INCLUDE DECIMAL POINT. 

1, %%%% NUMBER OF EXPONENT DIGITS, 

#» %%%% FLAG TO INCLUDE MANTISSA, 



00200000 
segment; DISK 
00200100 
00200200 
00200300 
00200400 
00200500 
00200600 
0Q200700 
00200800 
00200900 
00201000 
00201100 
00201200 
00201300 
00201310 
00201320 
00201400 
00201500 
00201600 
00201700 
00201800 
00201900 
00201905 
00101906 
00201907 

00201908 
00801909 
00201910 
00201911 



T 0000*0 
ADDRESS * 



00025 



T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 



n 



€ 






• 



• 
• 



INTEGER 

REAL 

INTEGER 

ARRAY 

REAL 

REAL 

REAL 

INTEGER 

REAL 

REAL 

REAL 

REAL 

REAL 

REAL 

REAL 

REAL 

REAL 

REAL 

INTEGER 

REAL 

REAL 

REAL 

REAL 

INTEGER 

REAL TPHR 

INTEGER U 
LABEL 



CQMM 

DEFINE L0 
MA 
SA 
MA 
P 

SUBROUTIN 

BEG I 



STOR 
URUF 
UTOP 
UvSKI 
FFCH 

SUPR 
BUFF 
B3I2 
FIB* 
WH2s 
WHls 
DH1 = 

DH2 = 
W = DH 
W1 = W 
W2 = W 
WT = W 
D = WT 
D1 = D 
D2 = 
DA = D 
SKIP 
CHR = 
F = CH 
ZERO 
CODE 
FAWs 
S«N = 
SCFT 
ASE*S 
s TPH 
RTNP 
STAR 

FMOU 
PHRA 
LQGI 
FTYP 
FORM 

ETYP 
RTYP 
ENT L 
G8 = 
X =g> 
VEBUF 
XCHR 

E CKP 
NX 
IF F 



D^UTYP.C 

F=UTYP.C 

=UTYP,[ 

P=UTYP,C 
RsUTYP.C 
S = UTYP 
=SUPRS+1 
E=BUFF+1 

BSIZE+1C 
FIB+U% 

wh2+i;x 
whi+i;x 
dhi+i;% 
2+1;% 

l + in 
2+i;x 
+ iu 
u;x 
i + ijx 
2+1;% 

=DA+li% 

skip+i;x 

r*i;% 

s»e+i;x 

sZEROS+l 

CODE + WX 
FAW + 1U 

r=sqn+i; 
cftr+i; 

RASE + 1 
RNT,EFA# 

T,ISFRM, 

T*Sj,S»L 
S/lNLOOP 
*ALFA>DO 
E*RFIN*F 
ATERRjTT 
E/REIN#E 

e*RctRy 

ABELS AR 
^ 1157163 
00077777 
FsTpHRAS 

*TPHRAS 

pohsh#; 
b;« 

ILX.C18I 
BEGIN I 



29S 63 ** 
16 S 133#* 

15513 #* 
09»63 

03*63 

+ i; 
;x 

n 



#; 



XXXX USED TO STORE ORIG VALUE OF Q, 

XXXX ADJUSTED BUFFER SIZE, 

X%%X FLAG TO INCLUDE TRAILING BLANK, 

XXXX « XTRA LEADING BLANKS FOR I OR F 

XXXX FREE FIELD DELIMITER <* OR BLNK) 



% 



efc*eeRtn*rna,rnb*x 

AEXL*ISA,ISB,aSLST,BS,BR,68,ERR0R*X 

fpar^rtpar, slash* scale* strng*x 
,astb*asta*ast*fldw*jmp*x 
type*xtype*itype*x 
a*fb*fc*fd*utype*ui*uf*esubtype*etypei*commm, 

YPE*8ACK, 

a»ertn're0t*eb»maxn#ten8»x 

e*rrtn»maxm,comm;x 

e listed in same order they appear;* 

034761674#*X 
77777777#*X 
E.t30Jl83#* 
E.C18U23#* 

X 



153 S I THENX 

f not filx, [18*153 thenx 

begin;stream(a**crealrowco3 3?b*o);x 

BEGIN SI*A; DI*Aj SI*SlM6J 

skip 2 sb;x 

if sb then tally * \}% 
a * tally;x 
fno;% 
if not p thenx 



00201912 
00201913 
00201914 

00201915 
00201917 

00201920 
00202000 
00202100 
00202200 
00202300 
00202400 
00202500 
00202600 
0S202700 
00202800 
00202900 
00203000 
00203100 
00203200 
00203300 
00203400 
00203500 
00203600 
00203700 
00203800 
00203900 
00204000 
00204100 
00204200 
00204210 
00204220 
00204300 
00204400 
00204500 
00204600 
00204700 
00204800 
00204810 
0020*900 
00205000 
00205100 
00205200 
00205300 
00205305 
06205310 
00205400 
00205500 
00205600 
00205700 
00205800 
00205900 
00206000 
00206100 
00206200 
00206300 
00206400 
00206500 



0000*0 
0000*0 
000010 

0000*0 
0000*0 
0000*0 
OOOOJO 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000i»0 
0001*0 
0002*1 
0003*3 
0005*3 
0006*2 
0006*3 
0007*2 
0007*3 
0008*0 



• 



* * 



• 



» 4 



8 SIZE 

BtjFF<- 

end;* 

iURROUTINE PRNT 
BEGIN COMM 

COMME 



BEGIN PCFILX#14#C0M#0EUJ'* 
FlLX f tie?153 * \i% 

end;* 

END/% 
BSI2E «- REALROW.ceilOm 
ENo Et SEX' 

*PDLlSHCMKS#UNSKP#CHSKP*SUPRS*(-l)#FItX*ALGOL,HRITE)J 
C*FILX)&BSIZEC8J38H03 * 



}% 

ENT 
NT 



P ( X C H 
IF FI 



>** 

LX, 

IF 

POL 

COM 

IF 

ELS 



RELEASE BUFFERS 
S- RETURN LITERAL.* 
S-l - IF TRUE THpN RETURN 
IF FALSE THEN EXIT)* 



AFTER RELEASE, % 



• 

• 



RTNPRNTJEND** 
SUBROUTINE DEBL 

STREAMCP3* 

BEGIN 

SUBROUTINE PRNT 

BEGIN COMM 

P(XCH 
IF TP 



[18*151 > 1 THEN% 

BSIZE>0 THEN 

ISHCMKS,LNSkP,CHSkP'SUPRS,BSIZE»FILX>ALGQLWRITE5J 

MENT WRITE RELEASE** 

P THEN CKPB* 

E BEGIN LSTRN «• TlSTRN;* 

IF FILX,[18»15]>1 THEN 

FILXENOT «3«-FILXCNGT 3)*0 ELSE 

IF FILXt[l8»153 * 1 THEN% 
P(FlLx*I4*C0M);« 

P(XIT3U 

end;* 
ank/ if chr<132 then 

P(BSlZE-CHR*DUP),P2«-p DIV 64,P1«-BUFF) ; 

P2(2(DS*32LIT" "))) P3CDS+LIT" ") END ; 
AU 
ENT BLANK TO END OF BUFFER OR TO 132 TH CHARACTER** 

WHICH EVER IS LfSSU 
); COMMENT S= XIT KEY IF TRUE THEN RETURN,* 

IF FALSE THEN EXIT U 
HRASE>0 THEN DEBLANK ELSE CHR*MAXCHR ; 



*VOIC 
*VOID 
*VOIO 
*V0ID 
*VOIO 
*V0IC 
*VOIO 



BSIZE*CIF CHrsO THEN BSlZE ELSE CHR+7) DIV 8) 

prnt; comment release buffer;* 
CHR *• 0;% 

bsize ♦ bsize x s;* 
tphrase«-buff<-pc,buff>lod»o*inx) ; 

end;* 
subroutine finde;* 

begin comment determine the exponent of a real number;* 
if wh1 = (lz<-zeros*0) then go to efc; 

E «• (C 04wHlU2»3l6]&wHlCl»2ti3 + 12) x L0G8) + ,5 I* 
:FA: IF ABS(WHl) > ( IF E> THEN TENtE]* 

ELSE 1/TENt-E])* 
THEN GO TO EERTN;* 



00206600 
00206700 
00206800 
0S206900 
OS207000 
00207100 
00207200 
00207300 
00207400 
00207500 
00207600 
00207700 
00207800 
00207900 
00208000 
00208100 
00208200 
00208300 
00208400 
00208500 
00208600 
00208700 
00208800 
00208900 
00209000 
00209100 
00209200 
00209300 
00209310 
00209320 
00209330 
00209400 
00209500 
00209600 
0©209700 
00209800 
00209900 
00210000 
00210100 
00210200 
00210300 
00210400 
00210500 
00210600 
00210700 
00210800 
00210900 
00211000 
00211100 
00211200 
00211300 
00211400 
00211500 
00211600 
00211700 
00211800 
00211900 



0008*1 
000913 
0011*0 

oou*o 

0011*0 
0012*2 
0012*2 
0015*2 
0017*2 
0017*3 
0018*0 
0018*0 
0018*0 
0018*0 
0018*0 
0018*1 
0019*2 
0020*3 
0023*0 
0023*0 
0024*1 
0026*1 
0027*2 
0031H 
0033*0 
0034*1 
0034*2 
0034*2 
0034*3 
0035*3 
0038*2 
0045*3 
0046*0 
0046*0 
0046*0 
0046*1 
0046*1 
0050*3 
0050*3 
0050*3 
0050*3 
0050*3 
0050*3 
0050*3 
0050*3 
0054*2 
0056*0 
0056*3 
0058*0 
0060*0 
0060*1 
006110 
0061*0 
0063*1 
0067*2 
0069*2 
0071*2 





# 



E 

GO 
EFCI e 

eertn:end;* 
subroutine r 

COMMENT 



* e - i;x 

TO IFM% 
* Qi% 



indqff;* 
adjust number 

TRAILING ZEROS 
RNAJ BEGIN IF AB3(PCCJUNK2 
THEN GO TO RNB* 

;ros * zeros +i; 

♦ DA-W CO 

to rna;% 
12 <- p; comment round off number;* 



RN8? 



REAL 



PC 

zf; 

DA 
GO 
DH 

end;% 

SUBROUT 
BE 



TO 12 SIGNIFICAT DIGITS PLUS* 

. NOTE DA * ADJUSTED <DECIMAL PLACES>;* 

«■ TENCDA3) x WHliDUP)) % MAX* 

COMMENT DA s ADJUSTED DECIMAL PLACES; 

COMMENT TRAILING ZEROS +l',% 
MMENT SUBTRACT 1 FROM DECIMAL PLACES** 



• 



EN 

SUBROUTINE S 

LABEL L*X*A, 

COMMENT 

START:: p( 

PC 

IF 

BEGIN P 

IF 

IF 

EN 
CK 
COMMENT 
IF 
IF 



INE LI 

GIN IF 

PC 

LI 

D LIST 

ETMAXC 

Z>I/G, 

START 

LSTRN, 

FILX, 

CFILXt 

FIBC5 

FIBC5 

COM 

D ELSE 

pb; CO 

CHECK 
FRMT 
ARRY 
IF 



STELEMENT 

LSTRN<0 
WH1* ,WH1# 
STELEMENT 
ELEMENT) 
hr; IF MA 
R*C,0>ZW2 
OF CODEi 
0*0*0);% 

C 16t 153 > 

NOT 2.1)}% 
3.C11 «2]< 
3, [43:13 
MENT CALL 

P(0)iX 
MMENT CHE 

FOR TYPE 
t THEN 
/ THEN* 
ARRY < 



then go to error; 
isn); whi*lisx; 

xchr<chr then maxchr*chr ; 
,zd*swt; 



1 THEN! 

2 THEN P(MKS#'*WRITNG"*FILX*7, SELECT) I 
THEN POL ISHCMK5,CHSKP#0*FILX> W SELECT ))% 
SELECT IF FILE NOT IN WRITE STATUS;* 



CK FOR PRESENCE 

OF write;* 

GO TO ISrRM;* 



BITJX 



COMMENT CA 
ISFRM: 



GO TO 
IF NO 
IF FI 



COMMENT CA 

AEXL* IF PC 

IF AE 

PCDEL 



ISA: 



ISB 



IF PC 
PCDEL 



SE * 
SUpR 

bb; 

t PC 
/O T 
BEG I 
SE a 
ARRY 
XP<0 
*AEX 
COMM 
DUP) 
>BSI 
COMM 



BSIZE ♦ P 

COMM 

COMMENT TRANSF 

STREAMCR4 
P2 * 



FORMAT 
SflJ* 
% 

FRMT»TOP 
HEN X** 
N TEMPO* 

AEXP^AR 
♦C8S10]* 

THEN PC 
P);% 
ENT STAC 

S BSIZE 
ZE);% 
ENT STAC 

OR AEXP 

ENT BSIZ 

ER ARRAY 

* CARRY 

BSIZE D 



THEN GO TO ASLST* 
ELSE GO TO AEXL;* 
w LIST a empty;* 



*XCH,DEL) THEN GO TO FMQUTI* 

FREE FIELD? CFI3 /{ TEMPD'AEXP- 13 . 

AExPwi; FRMT«-0; GO TO FMOUT END ; 

RAY ROW;% 

DUP) i AEXP THEN GO TO ISA;* 

ARRYCAEXP3) ; 

K «■ SMALLER OF ARRAY SIZE OR AEXP)* 
THEN GO TO ISB;* 

K * SMALLEST OF BUFFER SUE* ARRAY SIZE* 

;* 

e<-# of words to transfer;* 
to buffer;* 

C033, P3 ♦■ BSIZE** 
IV 64* Pi * * filx);* 



00212000 
00212100 
00212200 
00212300 
00212400 
00112500 
00212600 
00§12700 
00212800 
00212900 

00213000 
00213100 
00213200 
00213300 
00213400 
00213500 
00213600 
00213700 
00213800 
00213900 
00213910 
00214000 
00214100 
00214200 
00214210 
00214300 
00214400 
00214420 
00214500 
00214600 
00214700 
00214800 
00214900 
00215000 
00215100 
00215200 
00215300 
00215400 
00215500 
00215600 

00215700 
00215710 
00215720 
00215800 
00215900 
00216000 
00216100 
00216200 
00216300 
00216400 
00216500 
00216600 
00216700 
00216800 
00216900 
00217000 
00217100 



T 
T 

T 

T 
T 
T 
T 

T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



007211 
0073*2 
0076*0 

0076*3 
0077SO 
0077*0 
0077*0 
0077*0 
0079*1 
0080*0 

0080*1 
0081*2 
0082*3 
0085*0 
0085*2 
0085*3 
0086*0 
0087*1 
0088*3 
0089*0 
0089*1 

0093*3 
0093*3 
0093*3 
0095*0 
0095*1 
0096*2 
0098*1 
0101*2 
0104*2 
0104*2 
0106*1 
0107*0 
0107*0 
0108*2 
0109*2 
0111*0 
0112*0 
0112*0 
0112*3 

0113*1 
0115*0 
0115*3 

0118*3 
0118*3 
0121*0 
0122*3 
0123*1 
0123*1 
0124*2 
0125*0 
0125*0 
0125*0 
0125*2 
0125*2 
0125*2 
0126*2 



• 









* <i 



« 



BEGIN* 
SI 
P2 

OS 



«. pun 

CDS «■ 32 WDS;X 
DS * 32 WDS)*X 
«- P3 WDSSX 
END*X 



go to bb;% 
comment case = 



*,list;x 



ASLSTJ 
BS! 



• 



PCQ>.ISTRN>SND)J 

PCDUP*LISX); 

IF LSTRN > THEN 

BSIZE * PCDEUDEl 



COMMENT S*I*0;% 
COMMENT S«VALUE*5M*I*S«2«IJ* 
GO TO BR*X 
)• COMMENT BSIZE * I *X 

* OF WORDS IN buffer;* 



BR! 



BBS 



ERRORS 



BSIZE 
PCO); 

PRNTJ 

p c o ) ; 

PRNTA 

COMMENT CA 

FMOUTS LSTRN 

P(0>0 
P(O) 
OH1 «• 

WHl *• 
TPHRA 

BSIZE 
IF FR 



GO TO br;i 
)} 

FF],ST 

1»+>DU 

THEN G 

«• Pi% 



pcxch; 

PC CBUf 
IF PC 



P) < 8 

TO B 



SIZES! 

s*x 



COMMENT SaI»S-l»VALUE»S-2«i;X 
COMMENT VALUE TO BUFFERClJsX 



COMMENT FtAG TO EXIT ON CALLING PRNTU 



% 

% 

SE 



OF 
-C 



COMMEN 
#0,0#0 
* 
TEMPO 

lisx; 

SE«-BUF 
CQMMEN 
* BSI 
COMMEN 
MTsO T 
BEGIN 
CQOE*l 
FFCHR<- 
IF CFI 
B 



OMMENT CALL PRnTA AND EXITJX 
FORMAT^LIST OR FORMAT EMPTYJX 
ARRY = 0)*X 
T LSTRN <- -1 IF NO LISTSX 

FO>o*o»OfO#o*o,o#o»o#o#o*o»o»o»o);% 



SIS 



GO 
FI 



CODE 
UTYP 
TF FA 



E 

V 

ELSE I 

UTYP«-( 

FAW«-1& 

GO TO 
END EL 

s;x 

FI + 1 
COMMEN 
«• CFAW 
«■ 0«,8S 
W > 
COMMEN 



COMME 
F*PCO, 
T BUFF 
ZE x 8 
T BSIZ 
HEN XX 
XX 

i; Jun 

IF FI< 

<-ABSCF 

EG IN I 

BE 

TH 

JU 

LSE IF 

2+-TEMP 

F CV2* 

UTYP&J 

TEMPDt 

PHRAS 

SE 

;% 

T SET 

*• FRM 
IZEC16 

THEN G 
T IF 



NT GE 
[BUFF 

♦ AB 

E NOW 
X FRE 
% TO 
KUBS 

THE 

n-i) 

F TEM 
GIN I 
EN TE 
NK1*( 
(V2«- 
D END 
TEMPO 
UNKlt 
6*42* 



T FIRS 
3). [33 

SOLUTE 

# OF 
E FIEL 
< INf IN 

ize; I 

N n " 
*0 THE 
PD»0 T 
F (TEM 
MPD+1 
CTEMPD 
FIx(TE 
XXX A 
) = TH 
16*35* 
6]«V2[ 



T LIST ITEMSX 
s 15 3 ; 
CORE ADORESS;x 



CHARACTER 
D WRITE* 
ITY>U OR 
FCTEMPD*D 
ELSE "#" 
N XXX WE 
HEN XXX W 
PO*BSIZE/ 
ELSE IF T 
*21 )+2)xF 
MPD + 2)XB 
BOVE ELSE 
EN TEMPO* 
13]) OR 2 
32*42*6] 



S IN BUFFERSX 
WHICH IS EQUIVALENT 
<INFINITY>UX.X, 
Hl)>63 THEN TEMPq*63) 

t 

HAVE AT LEAST CFI3/. 

E HAVE CFIJ/COJ. 

FI-2, 4999999999)<0 

EMP0>21 THEN 

I END 

SIZE THEN JUNKl*V2 * 

WAS CFU/CTEMPO], 
63;XXXHAVE C03 /C03 OR 

; XXX[Q]/tTEMPQ]. 



INDEX TO NEXT EDITING PHRASE*X 
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: 35 8 13 3 J 
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GO 

COMMENT 



TO 
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LFPAR: 



RTPAR 



IF 
BEG 

END 



GO 
COMMENT 
P( 
IF 



PCCOD 
RTPAR 

STRNG 
LFPAR 

slash 
scale 

LEFT PAR 

FAW.C12S 

IN IF PC 

BEGIN 

ELSE PC 

COMMEN 

TO Si;* 

RIGHT PA 

3>5UB)J 

PCDUP) s 



E>; COMMENT SWITCH ON CODE** 
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vi 

GO 
COMMENT 
SLASH* POL 
PRN 

GO 
COMMENT 
SCALES SCF 

GO 
COMMENT 

STRNG! IF 

CHR 
SET 



BUF 
GO 
COMMENT 



PHRAS: 



IF 
IF 



«- FI -CF 

TO Si;* 
SLASHU 

ishcclst 
ta;comme 

COMMEN 
TO Si; 
SCALE FA 
TR*IF FA 

TO si;x 

STRINGS; 
PCCHR + 
THEN G 

♦• p ; 

MAXCHR t 
STRE 
BEGIN* 
S 
S 
D 
P 

end;* 
f <- p;% 

TO Sj;X 
BREAK AP 
FAW.C12S 
CODE-13 



; % 

ENTHESIS;% 
U THEN 
LISTELEMeNT*DUP)<0 THEN 

PCDEL); FI*FAW«E28liO]+Fi; ENQi 
FAW.C38U03); 
T MASK OUT REPEAT AND LEAVE IN STACK;* 

renthesis;* 

comment subtract one from lfpar repeat;* 
then begin* 

pcoed; comment delete o repeat;* 

go to si; comment pick up next phrase; 

end;* 



AW AND 10233; 



COMMENT SET FI BACK TO LFPAR; 



RNiOJ OR NOT FaW)J* 

NT RELEASE BUFFER;* 

T EXIT IF FORMAT & LIST EXAUSTEDJ* 

COMMENT SI IF LIST OR FORMAT NOT EXAUSTEDJ* 

f* t n r * i£ 

W, [12113 THEN LlSTELEMENT 

ELSE 0&FAWC38I38U03&FAWCU11I13J 

* 

CW^-FAW, C6563 )*DUP) > BSIZE* 

o to error; comment buffer overflow;* 

COMMENT CHR ♦• W+CHRJ* 

AMCP4 * 01 P3 t FAW,P2 * W#P1 * BUFF};* 

I «• LOC P2;* 
I «- SI-P2;* 
S «■ P2 chr;* 
A «• di;* 



ART FORMAT WORD;* 

13 THEN PCLISTELEMENT) ELSE PC F AW . [ 38 5 10 3 3 ; 

THEN CODEMF C c00E«"LI STELEMENT >* M D" THEN ELSE 



IF 
IF 
IF 
IF 
IF 
IF 
IF 
IF 
IF 
IF 



CODE-T' 

CODE^X" 
CODE="A" 

CODE* M I" 
CaDEs M F M 

C0DE*"E M 
CoDE* M U" 
CODE= H B" 
COOE«"0" 
CODEs H L" 
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THEN 
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THEN 

THEN 
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8 
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ELSE 
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11 ELSE 
110 ELSE 

12 ELSE 
14 ELSE 
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0210' 
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T 
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3 


00224400 


T 
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3 


00224410 
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0220« 
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00224500 
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00224600 


T 
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00224700 


T 


02221 
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00224800 


T 
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00224900 


T 


02231 
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00225000 
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0224 1 





00225100 
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0224' 
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00225200 


T 


02249 


2 


00225300 


T 


02251 





00225400 


T 


0225 1 


2 


00225500 


T 


0225? 


2 


00225600 


T 


02291 


1 


00225650 


T 


02331 
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00225700 


T 


02361 


1 


00225800 


T 


02381 


1 


00225900 


T 


02401 


1 


0©226000 


T 


02428 


1 


00226100 


T 


02441 


1 


00226110 


T 


0246> 


1 


00226120 


T 


02481 


1 


00226200 


T 


02501 


1 


00226300 


T 


02521 


1 
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m 
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IF C0DE«"R w 
IF COUEsllO THEN BEGIN CODEMIJ 

W*IF FAW.C13U3 THEN LlSTfLEMENT 
0*IF FAW.CHiU THEN 

ELSE 
EL.Se 
P(DUP)<0 THEN GO 
W<0 THEN 

IF CODE=l AND W=(-l) 
ELSE IF NOT(CODE=0 OR 
D<0 THEN IF N0TCC0DEX15 



IF 
IF 



THEN 15 ELSE 16; 

FAW,C31»U*1 END i 
•CCODEM) ELSE FAW f [6*63 
LISTELEMENT 

IF CODE*ll THEN FAW, [32*63 
CDl*FAW,C20U]) + CD2*FAWtC16lfl3); 
BACK; 



IF 



THEN GO BACK 

C0DEM2) THEN GO FURMATERR; 

AND C0DE*8 AND CQDE*iO> 



THEN GO TO FORMATERR ; 

IF W*0 THEN IF C0DE*2 AND CODE/1 THEN 
BACK: BEGIN P(oEL)i GO Si END ; 

IF CODEsll THEN BEGIN UTOP<-DHl*FAW , C 31 * 1 3 sO J 

IF (WH2*-UBUFF-DH1*FFTYP)<W THEN W*WH2 / IF D>WH2 THEN 
GO To ERROR; UTYP*UTYp&W[40$42*638,D[29S42*63 QR 1 ; 
INLOOP END ; 

OR FAW. [2:43-13 THEN 



GO TO 
IF FAW.U3*2]*0 
BEGIN 

GO 



THEN 8 ELSE IF CODE*l THEN 2 ELSE 

go i; go r; go g; go o; go l; 



INLOOP: 



PCIF C0DEM5 

cnoE) ; 

go c; go x; go a; 

go to formaterr ; 
|_: w 1 *- if w<5 then w else 5; go to z; 
x* wi*w div 64; w*skip«.w,[42I6JJ 

GO TO ZW2; 
A: Wi«.IF W<6 THEN W ELSE 6i 
Z* s«iP«-w»wi; GO TO ZW2; 
I: W1*IF W<8 THEN W ELSE 8; 

SKIP*IF W<16 THEN ELSE W-16J C0DE«-6 ; 

w2*w-skip*mi; go to zo; 

GJ D<-D + (UTIP OR FAW. [2:43*13 OR FAW,CUil3>J 
02«-D-Dl*IF DS8 THEN D ELSE 8; 
SKIP«"IF (W-D3S5 THEN ELSE W*D-5J 

wi*w2*o; code«-io; go to swt ; 

r; D2«.0-01*IF DS8 THEN D ELSE 8; 

SKIP*IF (H-0)<17 THEN ELSE W-0-17; 
W1*IF (W-D)S8 THEN w-D-1 ELSE fl; 
W2«*IF (W-D-SKIP)<9 THEN ELSE W"D*"SKlP*9; 
code+s; GO TO SWT ; 

c: 0: w*8; wi*skip*o; 

ZW2' W2«-0; 

ZO: D«-01*D2*0; 

SWT: WT<-Wi + W2; 

IF UTYP THEN BEGIN IF NOT ( <DH1*-TEMP0«W )<0 QR CODEXlO) THEN 
W*TEMPO ELSE DHi*OI IF ( WH2«-W + UTQP + FFTYP* 
USKIP)+CHR>UBUFF THEN BEGIN PCI)/ PRNTA END; 
CHR+CHR+WH2; SETMAXCHR; IF CODE-10 THEN BEGIN 
SKIP*SGN+DHl; GO ETYPE1 END ELSE GO JMP END I 

END ELSE 

BEGIN WT<-CWl«-FAW,C28:4]) + (W2*FAW,C24:4 3); 

SKlP«-FAw, [32*63; 

end; 

if code < 2 then go to fldwu 

utyp. [355534-27 ; **% sets umo*udc = ues*true* sets ued*2t 

USKlP«-0 ; 
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00227900 
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00228300 
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00229400 
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0254*1 

025750 

0260«3 
0264*2 
0267*3 
0269*3 
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0275*2 
0276*1 
0278*3 
0281*3 
0285*1 
0286*1 
0289*1 
0290*2 
0295*0 
0300*1 
0304*0 
0304*2 
0307*1 
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0316*3 
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0337*0 
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if lstRn>o then if utyp then go to utype 

ELSE GO To FLOW J 
PCO); COMMENT SET KEY ■ EXIT;* 

PRNTAJ COMMENT LIST EXaUSTED, RELEASE BUFFER AND EXIT; 
COMMENT FILL FIELD WITH *}% 
ASTB» P(DEL)* ASTA? PCDEDJX 

AST! STREAM.(P3*0I P2«-W#PU*UT IP* PUU*UTOP>PS*USKIP# 

PFF*FFTYPf 
PCH<-FFCHR> 

pi«-buff) ; 

BEGIN 

PSCOS^LIT" ") I 

P2(DS«-LIT W *"; PU(DI*OI-li DS^LlT^x")) } 

pffcsi«-loc pi; si*si-i; ds+chr) ; 
puucds«-lit« ") ; 

p3 ♦ dux 
end;% 



60 TO 
FC^MATERRJ IF 



FLDWJ 



JM P 



TEN 

STR 

P(C 

IF CO 

CHR «■ 
SETMA 

COMMENT SE 
IF CO 
IF CO 
GO TO 
GO TO 
GO TO 
GO TO 
GO TO 
GO TO 
GO TO 
GO TO 
GO TO 

COMMENT L 



LOGIJ 



com 

FILX 
BE 
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FI 
PC 
EN 

«-o; 

EAMC 
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DE = 1 
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PJ 

XCHR 
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DOT 

XTY 

ALF 
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FTY 
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DOT 

LOG 
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ST 



MM ; 
. C 18 

GIN 
FILX 

LXCN 
MKS# 
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TEN 
TEN) 
013. 
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GO 

• 
> 

EDI 

15 

HEN 
ODE) 

ype; 

pe; 

a ; 

pe; 

pe; 

pe; 

ype; 
i ; 
ase; 

REAM 



: 15 3> 1 THEN 

%%% NOT ARRAYR0W8UFF# 
CNOT 33) ; 

OT 33 «■ FILXtNOT A3 <- 
9#JUNK) ; 



SO TRY PAR LBL BRANCH, 



; 



*-PC[TENCl33#CFXf SFB) & 1QC8»38I10J 
; DS<-17LIT M -FMT ERR NO LBL**" ! 
C33»153*34,C0M) ; 

N GO TTYPE; IF PCW+CHR*DUP)>BSIZE 
TO ERROR; COMMENT BUFFER OVERFLOW!* 
COMMENT CHR «■ CHR + w;% 

TING phrase;* 

THEN GO TO RTYPE;% 
GO ERROR i 

* % 

COMMENT CODE ■ 0}% 
COMMENT CODE ■ 
CODE 
CODE 
CODE 
CODE 
CODE 
CODE 



COMMENT 
COMMENT 
COMMENT 
COMMENT 
COMMENT 
COMMENT 
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s 



2i% 
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io;% 

12U 



CP5 *• 0:P4 «■ IF 

P3 * Wl> P2 <■ 
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P2CDS «• LIT " 
SI «■ LOC ?H>% 
SI * Sj+3;% 
DS * P3 chr;s 
ps <• di;% 

end;% 



WH1 THEN "TRUE "% 

ELSE "FALSE" 
SKIP, PI «■ BUFF);% 



GO TO COMMM ; 
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DECREASE 
=0 XXX z 
AND E<1 
2<0)+l+E 



ASE TYPE> CU# UW OR UW.M) SELECTS 
TYPE> M» I / F / (SPECIAL) E>- 
PHRASE TYPE IT SELECTS A SUITABLE 



THE 



; ;* d 

OWING 

fy the 

INITI 
THAT 
NDITIO 

IN A 
T OF M 
PQSSTB 
TO THE 
OF LIS 
OMMENT 
ON #2 



CONDITI 
INEQUA 
ALLY FP 
M*W LEA 
N t\» T 
HIGHLY 
EANINGF 
LE FIEL 
EDITED 
T ELEME 
S, "FUL 
UNRESTR 



ONS ARE SAT 
LITIES, M < 
S W AND L* 
DING BLANKS 
HE SELECTED 

READABLE FO 
UL NUMERIC 
D WIDTH. A 

LIST ELEME 
NT TO BE ED 
L WORD" IS 
ICTED BY CO 



ISFIEDS 

FP < W, 
TER FP IS 

ARE SUPPLIED 

PHRASE 
RMAT* THE 
SIGNIFICANCE 
BLANK SPACE 
NT, 

ITEDt AND 
USED IN THE 
NDITION #1, 



V2 ; %XX WE N 
W<TEMPD THEN 

GO TO I M 



XX RETAIN ORI 
XXX RESTORE 
ENTIERCL0G10 
S USF OF PART 
ERO IS INTEGR 
0)) XXX WHl 
)<W XXX V2 

XXX FOR 
QW USE FULL W 
USKIP*TEMPD-W 
XX RESTORE WH 



G WHl, NORM WHl FOR FlNDE 

W* Ul IS SENT TO I-TYPE. 

CABSCWH1))],PE<WH1<^E+1» 

IAL WORDS. 

AL* REGARDLESS OF EXPQNT 

IS INTEGRAL AND NOT BIG 
s MINIMUM WIDTH REQUIRED 

FULL WORD i-TYPE. 
ORD I-TYPE, 

j XXX PHRASE GETS BLNKS 
1 AND EXIT TO I-TYPE. 



XX 
XX 
XX 
XX 
XX 
OR 



N JUNKl 
K I* JUNK 
K1=TENT 
EGIN WH 
SGN[1*4 

nd ; 



H2*E< 

(0*11 

D-E3 

1 = M 

# DIG 

MANT 

= TRU 

= TRU 

= TR 

THEN 

*JUNK 

1-01 + 

m t 

1*(IF 

7iu; 



THEN W 
«(Wl>5 t 4 

• 

ANTISSA 
ITS- 1 IN 

ISSA OF 
E IF WHl 
E IF WHl 
UE IF WH 
IF (Dl* 
1-01 ELS 

io ; 

HEN IF D 
E>(-1) 

GO TO 



Hl*TENt-E3 ELSE WHi/TENCE3)>5 ; 
9755813885JXE THEN WHl/TENtE-Dl 

OF WHl AS AN 11 OR 12 DIGIT INTEGER. 

JUNKl. 
WHl AS N.NN...N. 

> MAX INTEGER, ELSE DHl * FALSEt 

< 1, ELSE DH2 = FALSE. 
1 WOULD ROUND UP» ELSE SKIP a FALSE. 



JUNKl MOD 
E IF Dl>7 



10X3%%* 

THEN XXX 

XXX 

*11 THEN 

THEN TENCE+13 

UTYP E ; 



HERE WE HANDLE ANY 
CONVERSION TRUNCA- 
TION PROBLEMS, 



ELSE 1/TENC*CE+1)3> 



JUNKl MOD TENCD13=0 
2; IF NOT JUNK1*ABS 
*2+SGN+DH2)+i+DA+JUN 

((2+DA<(-E) 
(0*D+1»D1)+DA<E) 

(ABS(E)*4 OR W<2+SG 
1*IF DH2 THEN ELSE 
EGIN 



DO Dl*Dl+i;XXXDl=l+#TRAlLN IN JUNKl 
(E)>9 THEN UED*i; UDC*DA*D1-D* 1 i 
Kl ; XXX WT IS MAIN FIELD WIDTH FOR E 
XXX WHl BEYOND MAXIMUM F'-TYPE RANGE 
XXX OR WHl HAS LESS WIDTH IN THE 
XXX E-TYPE THAN IN THE F-TYPE* 
N XXX AND IT WOULDNT LOOK BETTER IN F 
E)+D2*IF D<E THEN 1 ELSE D-E)> THEN 
XX% THEN WE SHALL TRY E-TYPE. 



00233703 
00233706 
00233709 
00233712 
00233715 
00233718 
00233721 
00233727 
00233730 
00233733 
00233739 
00233742 
00233745 
00233746 
00233747 

00233748 
00233751 
00233754 
00233757 
00233760 
00233765 
00233775 
0Q233778 
00233781 
00233784 
00233787 
00233788 
00233790 
00233791 
00233793 
00233796 
00233800 
00233802 

00233804 
00233806 
00233809 
00233812 
00233813 
00233815 
00233816 
00233818 
00233821 
00233824 

00133825 
00233826 
00233827 
00233828 
00233829 
00233830 
00233831 
00233832 
00233833 
00233836 
00233839 
00233840 
00233841 

00233842 



0459*0 
0459*0 
045910 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0459*0 
0461*1 
0463*2 
0465*0 
0466*1 
0467*2 
0470*1 
0473*0 
0473*3 
0475*0 
0478*2 
0479*3 
0479*3 
0485*3 
0490*0 
0493*0 
0493*0 
0493*0 
0493*0 
0493*0 
0493*0 
0493*0 
0495*3 
0500*3 
0503*0 
0505*1 
0510*0 
0512*2 
0512*2 
0513*1 
0517*0 
0526*0 

0529*3 
0529*3 
0531*1 

0534*2 
0536*0 

0543*2 



4P 



# 



ELSF 
XXX D 
XXX D 
XXX D 



IF DH 
02 



IF 



IF 

FS 
IF 
UD 
IF 
DM 

Wl 
TF 



EN 
EN 

FL 
D* 
EN 
IF 

1 

2 

BE 

UF 

WH 

EN 

2 



ELSE 



X IN T 
D + WT< 

BEG 
GO 

END 
NOT ( 
V2*W) 

UBTYPE 
(D*W<- 

c*o ; 

D + OAs 
D*0 ; 
♦•NOTCW 
DH2 T 
BEGIN 
W«-W-( 
ELSE 
D ELSE 
D %%% 
SE IF 
W-l-CW 
D 
W>Dl + 
# DEC 
* MlNi 

a 1 + 
GIN w 
x IF 
J«-WH2j! 

o; 

THEN I 

2-CWHl 

CW + E < 

D2*D2 



HE ABUVE, a # DECIMAL PLACES FOR FULL WORD ETYPE 
W THEN XXX D + WT = MINIMUM FIELD WIDTH REQUIRED 

in w«-d+wt;x%x FOR full word e-type. 

to g ; XXX exit to first phase of e-type phrase. 



0H1 OR XXX 

THEN GO Ul 



E-TYPe WIDTH WAS TOO SMALL TO HANDLE 
; XXX NN.,,NQO,..0.0, SO DROP ,0# GO I 



WT)>0 
XXX N 
0*0 T 
XXX N 
2+JUN 
HEN 8 

XXX 
DH2<W 
IF Wl 

IF ( 
WH1>1 
Wl TH 
+ E + SK 



THEN 
ROOM 
HEN GO 
ROOM 
K1XW 
EGIN I 
WH1<1* 

j; if 

THEN 
E>8)+W 
, ROUN 
EN GO 



GO TO 
FOR D 
G } % 
FOR M 
R (JUN 
F (DH2 
ROUND 
( E*E + 
GO TO 
2 = W AN 
D UP T 
G ; XX 
SGNJ 



g ; xxx w 

FCIMAL PO 
XX FORM I 
ANTjSSA* 
Kl*Wl)Xl) 
«-C*E>10) + 
UP TO <S 
l)a(»9) T 
6 XXX DEL 
D SKIP TH 
C <SIGN>P 
X DEL 1 I 
GO TO UF 



CD*D2)+D2*2 
IMAL PLACES 
MUM WIDTH R 
#DIGITS TO 

* di ; xxx 

W<TEMPD THE 
GO TO R i 



+SGN+D1 THEN XX 

for full word 

EGUIRED POR FUL 

THE LEFT OF THE 

FULL WORD F-TY 

N USKIP*TEMPD'W 

XXX RESTORE WH 



HI FI 
INT, 
S <SI 
SO WE 

t 
W2)<W 

iGN>e 

HEN U 
1 IN 
EN BE 
<EXP + 
N <SI 
i XXX 

xxx 

X HAN 
F-TYP 
L WOR 

DECI 
PE, 

I XX 
1 AND 



TS ROUNDED E-TYPE. 
SO WE RESET FLAG, 
GN>NP<EXP>,G0 TO E, 
RESET FLAG, 



AND SKI 
<EXP+1>» 

eo*i; G 

<SIGN>1 
GIN E*E+ 
1>, GO T 

GN>1P<EX 
GO TO F 
**.«»*/ 

OLE VAR1 

E, 

D F-TYPE 

MAL PLAC 



P THEN 
GO TO ETYPE 
TO G END 
0<EXP>,GO E 
i; GO TO G 
E-TYPE, 
P>, GO TO E 
-TYPE FOR 
C0).00.,,0 
OUS F*TYPES 



t 
E, 



X PHRASE GETS BLNKS 
EXIT TO F-TYPE. 



F SGN THE 
<.5 OR WX 

i-SKIP) 
•1 ! 



IF (D4.W-D2)>0 THEN GO 



IF D2 
GO TO 
COMME 



-1 

E 

NT 



ALFA! 



«W THE 

SUBTYP 

A PHR 

STR 



N GO TO U 

E J XXX A 

ASE } 

EAM(P5 «• 
PI 
BEGINX 
P2 
SI 
SI 
DS 
P5 

end;x 



N XXX DH2 SAYS WHHO ,NN . , ,N* SQ SINCE WE 
2)XXX CANNOT FIT FULL WORD IN F-TYPE* WE 
XXX THEN DELETE LEADING ZERO (IF DO NOT 
XXX HAVE TO ROUND INTO IT), AND IF SHALL 
XXX HAVE TO ROUND TO 0, DELETE -SIGN TOO 
TO UF i XXX AFTER ABOVE SURGERY, IF CAN 

XXX ROUND THEN SEND WHi TO F-TYPE 
I ; XXX TRY WHI ROUNDED TO AN INTEGERt 
S A LAST DITCH EFFORT' TRY ROUNDED E-TYPE 



OS 



P4 * WHl, 
BUFF5JX 



(DS * LIT w ' 

* LOC P3'X 

* SI - P3;X 

* P3 cHr;x 

* di;x 



P3 «- Wl, P2 ♦ SKIP, 



)i% 



GO 
COMMENT 
DOTYPE' 



TO COMMM } 
Q & PHRASES^X 
STREAM(P4 * 







P3 «• IF CODE = 



THEN 

else 



ox 

WHi,: 



P2 * SKIP, PI «• BUFF3;% 
BEGINX 

P2CDS «■ LIT " ");X 



00233845 
00233848 
00233851 
00233854 
00233857 
00233860 
00233863 
00233864 

00233865 
00233866 
00233867 
00233868 
00233869 
00233870 
00233871 
00233872 
00233873 
00233874 
00233875 
00233876 
00233877 
00233878 
00233879 
00233883 
00233886 
00233889 
00233892 
00233893 
00233895 
00233896 
00233899 
00233900 
00233903 
00233906 
00233909 
00233912 
00233915 
00233918 
00233921 
00233994 
00233997 
00234000 
00234100 
00234200 
00234300 
00234400 
00234500 
00234600 
00234700 
00234800 
00234900 

00235000 
00235100 
00235200 
00235300 
00235400 
00235500 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 



0544 
0544 

0545 
0547 
0547 
0547 
0547 
0549 

0549 
0551 

0553 
0555 
0557 
0560 
0564 
0565 
0571 
0572 
0577 
0578 
0579 
0583 
0583 
0588 
0588 
0588 
0588 
0589 
0592 
0594 
0594 
0595 
0597 
0599 
O6O3 
0603 
0605 
0605 
0607 
0607 
0607 
0609 
0609 
0609 
0611 
0611 
0611 
0612 
0612 

0612 
O612 

0613 
0613 
0615 
0616 
0617 
0617 



• 

• 



• 
• 



SI 
OS 

pit 



LOC pa;% 

8 CHR;% 

di;% 



ENOi% 






GO TO Cf]MMM J 
COMMENT X PHRASE;* 
X7YPES IF PCCHR + (Wlx64)#DUP) > BsUEX 

THEN GO TO ERROR/ COMMENT 
CHR«-P; SETMAXCHR I 

STREAMcPa ♦ 0* P3 «. Nl» P2 
BEGIN% 

P2CDS * LIT H ">** 
P3C32CDS <- 2 LIT 
P4 * DUX 

end;« 



BUFFER OVERFLOWS 

* SKIP* Pi «■ BUFF);% 



« ii 



)U% 



GO 
COMMENT 
TTYPEI 



TO COMMM ; 
T PHRASE ; 
IF TPHRASE>0 THEN BEGIN OEBLANK; TPHRASE*»TPHRASE 
IF CCHR«-W + Wlx64)>B5lZE THEN GO ERROR ; 
STREAM (P3«-SAVEBUFF»P2*W#Pi*Wl) J 

BEGIN Sl«-P3; Sl*SI+P2; Pl(2CSI*Sl + 32)>; P3*SI 
GO COMMM / 
COMMENT I PHRASE;% 



END 



END 



> P(MAXN)% 

COMMENT FILL FIELD WITH 
COMMENT ROUND NUMBERS 



ITYPEJ IF A8S(P(WHl,DUP3) 
THEN GO TO ASTA; 
PC ,WH1MSN>DUP)J 

son * p < o;* 

WH? <-CWHl *■ ABS(P)) DIV P(TEN8)I% 
IF HH1 > TENCWT-SGN]% 



*;% 



m 



THEN GO TO AST; 

STREAMCP8 * 0! P7 
P4 *■ W2»P3 
PFF*FFTYP> 
PCH<-FFCHR> 
PI * BUFF) 
BEGIN* 

P2CDS * 

PI 

Si 

DS 

SI 

SI 

DS 



COMMENT NUMBER > FIELD WIDTH** 
«• WT-1» P6 * [WH23#P5 <■ SGN,% 
*■ Wl*P2 *■ SKIP + USKIP#PU«.UT0P» 






LIT •» «);x 

Oi; COMMENT SAVE STARTING ADORESSJX 

P6;% 

COMMENT CONVERT HIGH HALF;* 



CONVERT LOW 
DS*CHR) 



half;% 



P4 dec; 

p6;* 

si+8;* 

P3 dec; comment 
pffcsi*loc pi; si*si*i; 
pucds *• lit m ") ; 
P8 «• oi;x 

01 «- PU* 

ds «• p7 fill; comment leading zeros*blankS;% 

P5CDI * Dl-i; DS «■ LIT""") ; 



00235600 
00235700 
00235800 

00235900 
00236000 
00236100 
00236200 
00236300 
00236400 
00236500 
00236600 
00236700 
00236800 
00236900 
00237000 
00237100 
00237200 
00237300 
00237305 

00237308 
00237310 
00237315 
00237320 
00237325 
00237400 
00237500 
00237600 
00237700 
00237800 
00237900 
00238000 
00238100 
00238200 
00238300 
00238305 
00238307 
00238310 
00238400 
00238500 
00238600 
00238700 
00238800 
00238900 
00239000 
00239100 
00239105 
00239110 
00239200 
00239300 
00239400 
00239500 
00239600 
00239700 
00239800 
00239900 
00240000 
00240100 



T 
T 
T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0618*1 
0618*2 
0618*3 
0619*0 
0619*1 
0619*1 
0619*3 
0619*3 

0621*1 
0622*1 

0624*0 
0625*3 
0625*3 
0627*0 
0628*3 
0629*0 
0629*1 
0629*1 
0629*3 
0629*3 
0633*0 

0635*3 
0637*3 
0640*2 
0641*0 
0641*0 
0642*0 
0642J3 

0643*2 
0644*2 
0646*1 
0647*1 
0648*1 
0650*1 
0652*3 
0653*2 
0654*1 
0654*3 

0654*3 
0656*0 

0656*1 

0656*2 

0657*0 

0657*1 

0657*2 
0658*0 
0659*2 
0660*3 
0661*0 
0661*1 
0661*3 
0663*1 
0663*1 

0663*1 
0663*1 
0663*1 
0663*1 



# 



• 



COMMENT 
FTYPEJ 



end;* 
go to commm ; 

F PHRASE;* 
IF ABSCWH1 * 
THEN GO TO 



RFIn: 



FA* 



MAXN? 5 8 



IF NOT UTYP T 
IF CE + (DA «• 
COMMENT 
11 
DH2 ♦ HH1 * ( 
COMMENT 
OFF 
SGN * DH2 
DH1 *• (DH2 «■ 
IF DH2 > JUNK 

COMMENT 

IF PCWT-SGN* 

COM 

LZ «■ P i CJUNKl 

COMMENT 

IF 

IF 

go fc ; 

$000777777777 

COMMENT 



WH1 x 1, 

ast; COM 

HEN FIND 
0)) > 1 
DA * DE 
DECIMAL 
JUNK2 ♦ 
SHIFT NU 
BY DOIN 

< o;% 

ABS(DH2) 
2 THEN G 
NUMBER I 
DUP) < 
MENT AST 
♦ 0)1 
JUNKI ■ 

WT-SIGN 
ZERO.* 

WT-SIGN 
ZERO** 

7777 ; 

NUMBER i 



0) > P(MAXN)% 

MENT INSURE NUMBER IS REAL AND NQT% 
TO BIG** 

e j%finde sets f*c l0g10c absc whl ) ) 3 , 
c then go to fd;* 

cimal places. if d+e>10* more then* 
places so must do special round** 
tencdD;x 

mber left d places then round it* 
g integer store in dh2;* 

) div pcten8);* 

o to fb;* 

S LESS THEN ONE* WILL SIGN FITJ* 

THEN GO TO ASTA;* 
A IF SIGN DONT FIT;* 

# OF INTEGER DIGITS TO PRINT,* 

* THEN JUNK1*0- DONT PRINT LEADING 

> THEN JUNK1*1« 00 PRINT LEADING* 



FB: 



IF ((JUNKI * E + (IF DH2 



+ SGN } 
COMMENT 



FCS 



COMMENT 



> WT TH 
FOR NU 
NUMBER 
POINT. 
E+2'DE 
OCCURE 
WITH W 

WILL F 
OF PQS 
+ SIGN 
NOW WE 
IS NOW 
* DENO 
, DENO 
ZEROS 
JUNKi 
DA C 
NOTE T 
THE ST 
NUMBER 
DH1 AN 
OF DIG 
POINT, 
ARE IN 



CHECK IF ON ROUND WE OVERFLOWED* 
INTO NEXT POWER OF TEN;* 
> TENCE+1+DA3 THEN 2* 

ELSE 1))X 

ast;* 

* e * one less than the* 

S LEFT OF THE DECIMAL* 

WE SAVE EITHER E+l OR* 
N IF ROUND OVERFLOW* 
E COMPARE .JUNKI + SIGN* 
ELLS US IF THE NUMBER* 
ELD, WT * TOTAL NUMBER* 
AILA8LE FOR INTEGER DIGITS* 



EN GO TO 
MBERS > 1 
OF DIGIT 
IN JUNKI 
PENDING 
D. ALSO W 
T, THIS T 
IT THE FI 
ITIONS av 
}% 

CONVERT. 

AN INTEG 
TES TRUE 
TES MACHI 
CONTAINS 
CONTAINS 
ONTAINS * 
HAT WH2 + 
REAM PROC 

IN TWO P 
D DHp). I 
ITS LEFT 

ALSO THE 

serted;* 



NOTE THAT NUMBER* 
ER IN THE FORM N»-N*N*-N t * 
DECIMAL POINT* 
NE POINT* 

t OF TRAILING ZEROS* 
« OF DIGITS LEFT OF ** 

OF DIGITS BETWEEN * &,% 

ZEROS ALWAYS = D,% 
EDURE WILL CONVERT THE* 
ARTS (ALREADY SET UP IN* 
T WILL THEN MOVE JUNKI t% 
AND INSERT THE DECIMAL* 

SIGN AND TRAILING ZEROS* 



00240200 
00240300 
00240400 
00240500 
00240600 
00240700 
00240800 
00240900 
00241000 
00241100 
00241200 
00241300 
00241400 
00241500 
00241600 
00241700 
00241800 
00241900 
00242000 
00242100 
00242200 
00242300 
00242400 
00242500 
00242600 
00242700 
00242800 
00242895 
00242900 
00243000 
00243100 
00243200 
00243300 
00243400 
00243500 
00243600 
00243700 
00243800 
00243900 
00244000 
00244100 
00244200 
00244300 
00244400 
00244500 
00244600 
00244700 
00244800 
00244900 
00245000 
00245100 
00245200 
00245300 
00245400 
00245500 
00245600 
00245700 



0663*1 
0663*1 
0663«2 

0663*2 
0664*0 
066a»0 
0665*3 
0666*2 
0666*2 
0669*0 
0671*1 
0671*1 
0671*1 
067311 
0673*1 
0673*1 
0674*2 
0676*2 
0677*3 
0677*3 
0679*3 
0679*3 
0681*1 
0681*1 
0681*1 
0681*1 
0681*1 
0681*1 
0685*0 
0686*0 
0686*0 
0686*0 
0689*0 
0690*2 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692J0 

0692*0 
0692*0 
069210 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 
0692*0 



• 
• 



* «t 



D1«-DA + JUNK1-CD2<-IF PCJUNKi +DA»DUP) > 8 THEN P(8>SUB)* 

ELSE P(DEL#0));* 

3#P5*SGN> 

Z+USKIP*PU*UTQP> 



STREAM CP94-0! P8* JUNK 1+LZ»P7*ZER0S#P6*CDH1 

P4«-Dl>P3«-D2>P2«-SKlP + KT*JuNKl*L 

PFF*FFTYP» 

PCH*FFCHR» 



PI «- BUFF) > 
BEGIN* 

P2CDS«.IIT 

pi*di; 
di*di+i; 



• 



LZ, 

")/ COMME 

COMMEN 

COMMEN 

P 

L 



nt insert leading blanks;* 
t save address of msqj* 
t leave room for integer* 
art;* 

ZCDS*IIT"0"); 



COMMENT CONVERT HIGH PARTI* 



Si «-P6!% 

DS«-P3 OECI 
Sl«-P6;* 

si«-si+8;% 
os«-P4 dec; 

P7(DS«.LIT m O"3; 

pffcsi*loc pi; 
pucds * lit" ") 
P9*di; 

SI*P1JI 

si«-si + i;% 

DUP1I 

os*P8 chr;* 
ds«-lit m .";% 
p5(oi * pi; di * oi-i; ds <• lit«»«) i 



COMMEN 
COMMEN 

sl*si- 
; 

COMMEN 



T CONVERT LOW HALF!* 

T INSERT TRAILING ZEROS;* 

l; DS*CHR) ; 

T ADDRESS OF NEXT FlELQ;* 



COMMENT MOVE INTEGER PART LEFTJ* 



FDS 



GO 



DA 



ETYPEJ 



EA: 



end;* 

TO COMMM ; 

COMMENT MORE THEN It SIGNIFICANT DIGITS SO WE HAVE* 
TO DO SPECIAL ROUNO;* 
«- D -(ZEROS * E + D-m;* 

COMMENT FIRST GUESS aT TRAILING ZEROS;* 

rndoff;* 
go to fa;% 
comment e phrases;* 

IF D + 6 > W THEN GO TO AST; 

«. cum «- whi x i.o) < o; 

finde; comment e * exponent;* 

pci) ; *** return literal used at redt, 

IF CDA+D-1) > 10 THEN GO tO E8I COMMENT SPECIAL 

if more then 11 significant digits** 
p(0); comment set literal to not adjust d2 at 
dh2 * c if ce*d) * 0* 
then whi / tence-d+u* 

ELSE WHI x TENCO-1-E]);* 
COMMENT NUMBER NOW IN FORM OF N*N— — N.* 

WHERE * * TRUE DECIMAL POINT* 



SGN 



ETYPEU 
REIN! 



ROUND OFF 



ertn;* 



00245800 
00245900 
00246000 
00246100 
00246105 
00246107 
00246108 
00246110 
00246200 
00246300 
00246400 
00246500 
00246600 
00246650 
00246700 
00246800 
00246900 
00247000 
00247100 
00247200 
00247205 
00247210 
00247300 
00247400 
00247500 
00247600 
00247700 
00247800 
00247900 
00248000 
00248100 
00248200 
00248300 
00248400 
00248500 
00248600 
00248700 
00248800 
00248900 
00249000 
00249100 
00249200 
00249300 
00249400 
00249500 
00249600 
00249650 
00249700 
00249800 
00249900 
00250000 
00250100 
00250200 
0025030Q 
00250400 
00250500 
00250600 



0692*0 
0695*1 

069712 
0699*3 
07031-3 
0704*2 
0705*1 

0705»2 
0706*0 
0706*0 
0707*1 
0707*2 
0707*3 
0707*3 
0709*0 
0709*1 

0709*3 
0710*0 
0710*1 
0710*3 
0712*0 
0713*2 
0714*3 
0715*0 
0715*1 
0715*2 
0715*3 
0716*1 
0716*3 
0718*2 
0718*2 
0718*2 
0718*2 
0718*2 

0718*2 
0718*2 
0718*3 
0718*3 
0721*0 
0721*0 
072l»0 
0723*3 
0723*3 
0725*0 
0725*2 
0725*2 
0727*3 
0730*0 
0731*0 
073111 
0733*2 
0733*2 
0733*3 
0734*3 
0737*0 
0740*2 
0740*2 









• 
• 
• 



IF C DH2 * A8SCDH2) 
THEN BEGIN? 

DH2 

E * 
ENDJ% 

COMMENT IF ROUND OV 
10 WE SET 
EXPONENT 

DHl * 0H2 DIV PCTEN 



E * EXPONENT? 

, = machine point? 

DA = # OF DIGITS BETWEEN * S ,% 
DA ♦ ZEROS b <DECIMAI PLACES>? 
STORING IN DH2 ROUNDS NUMBER;* 
) > TENCDA+13% 



TENCDA3;* 

+ i;% 



ERFLOWfD THE LEADING DIGIT FROM 9 T0% 
OUR NUMBER TO 1,0 AND INCREASE? 

BY one;? 

8);C0MMENT SINCE HARDWARE CAN CONVERT? 
ONLY 8 DIGITS WE SPLIT NUMBER IN TWO? 
PARTS AT 8 TH DIGIT;? 



*BS(E)*P8 * 
* CDHl]>P4 
<- UTOP 



E<0)>P7 * SGN,% 
02*P3 * Dl*? 

,PES * UES, 



• 



IF FALSE THEN 
TEN8:?s 01045753604000000 ; 

STREAM(P10«-0SP9 «■ A 
P6 «- ZEROS, P5 
P2 ♦ SKIP# PU 
PFF ♦ FFTYP, 
PCH*FFCHR» 

RED * UED'PDC <- UDC'PMD <■ UMD* PI «■ BUFF) ; 
BEGIN? 

P2CDS*LIT 
PI ♦Oil 



" "); COMMENT INSERT LEADING BLANKS!? 
COMMENT SAVE ADDRESS OF INTEGER? 



P7CDI * dim; 



digit;? 
ds*lit»« m ); 



COMMENT SAVE ROOM FOR INTEGER 

digit;? 

COMMENT CONVERT HIGH HALF J 



PDCC0I*DI+1 ; 

SI*P5;? 
DS*P4 DEC) ; 
PMD(Si«-P5 ; 

si«-si+8;? 

ds«-p3 dec; comment convert low half;? 
p6c0s>lit»0«)) ;comment insert trailing zeros i 
ds<-lit w r;i 

PESCDS*LIT" + W ; P8(DI*DI«"U OS*L lT"»* ) ) I 



si*loc p9; comment convert exponent;? 

ds «• peo dec; 

pffcsi*loc ped; si«-si-i; ds«-chr) ; 

pucds ♦• lit" " ) ; 

plo«-di; comment address gf next field!? 

pdccsi*pi ; 

si*si+i;x 

oi«-pi; comment move integer digit left! 



00250700 


T 


0740*2 


00250800 


T 


0740*? 


00250900 


T 


0740*2 


00251000 


T 


0740*2 


00251100 


T 


0740*2 


00251200 


T 


0740*2 


00251300 


T 


0742*1 


00251400 


T 


0743*1 


00251500 


T 


074411 


00251600 


T 


0745*2 


00251700 


T 


0745*2 


00251800 


T 


0745*2 


00251900 


T 


0745*2 


00252000 


T 


0745*2 


00252100 


T 


0746*3 


00252200 


T 


0746*3 


00252210 


T 


0746*3 


00252220 


T 


0747*0 


00252300 


T 


0749*0 


00252400 


T 


0751U 


00252500 


T 


0752*1 


00252505 


T 


0754*0 


00252507 


T 


0754*3 


00252510 


T 


0755*2 


00252600 


T 


0758*1 


00252700 


T 


0758*1 


00252800 


T 


0759*2 


00252900 


T 


0759*3 


00253000 


T 


0759*3 


00253100 


T 


0761H 


00253200 


T 


0761*1 


00253300 


T 


0761*1 


00253400 


T 


076lti 


0025350Q 


T 


076H1 


00253600 


T 


0761*1 


00253700 


T 


076111 


00253800 


T 


0762*0 


0©253900 


T 


0762*0 


00254000 


T 


0762H 


00254100 


T 


0763*0 


00254200 


T 


0763*3 


00254300 


T 


0764*0 


00254400 


T 


0764*2 


00254500 


T 


0766*0 


00254600 


T 


0766*2 


00254700 


T 


0769* 1 


00254800 


T 


0769*1 


00254900 


T 


0769*1 


00255000 


T 


0769*1 


00255100 


T 


0769*1 


00255200 


T 


0769*2 


00255205 


T 


0770*0 


00255210 


T 


077112 


00255300 


T 


0772*3 


00255400 


T 


0773*0 


00255500 


T 


0773J3 


00255600 


T 


0774*0 



* « 



# 

# 



• 
• 



• 



ds*chr;* 

DS«-UT", M ) J 

end;* 

BUFF * Pit 
ERTN5 IF P THEN 0.2 * D*8>% 
RE0T* IF NOT P THEN GO TO RRTNI COMMENT OUT IF FROM RTYPEI* 

GO TO GOMMH 
E8J COMMENT MORE THEN 11 SIGNIFICANT DIGITS* 

REQUESTED SO DO SPECIAL ROUNDS 
DA * D'l-CZEROS* D"12);* 
WHl * CIF E>0 THEN WHl / TENCE3* 

ELSE WHl x TENC-E]);% 
COMMENT NUMBER NOW IN FORM N.NNN WITH EXPONENT IN El 
RNOOFFI COMMENT ROUND OFF NUMBER** 

D2 * DA - 7}% 

PCI); COMMENT SET KEY TO ADJUST 02 AT ERTNI* 
GO TO EA;* 
COMMENT R PHRASED 
RTYPE: WHl * IF SCFTR > THEN WhI x TEN[ SCFTR ] * 

ELSE WHl / TENC-SCFTRm 
FINDER 

SGN * WHl < 0)% 

IF ABS(WHl) > P(MAXM) THEN GO TO TRYEI* 
IF E * THEN* 

BEGIN COMMENT CHECK IF IT WILL GO AS F FIELDS 
IF (E+2+D+SGN) < W THEN* 
BEGIN COMMENT Y E S- IT WILLI* 
RCt SKIP * W-(D+l+WT)i% 

GO TO RFIN* 
END ELSE GO TO T^YE! COMMENT TO BIG FOR Fl* 
END* 

ELSE* 
BEGIN COMMENT NUMBER IS LSS THEN 1, SEE IF IT WILL* 
GO AS F FIELD WITHOUT LOSS IN REQUESTED* 
ACCURACY;* 
IF ABS(E) < D THEN GO TO RCI* 

COMMENT TO RC IF IT WILL GO AS F FIEUDI* 
END I % 
COMMENT SEE IF NUMBER WILL FIT IN E FIELDI* 
TRYE* IF W < (D+6+SGN) THEN* 

BEGIN COMMENT FIELD TO SMALL FOR E, IF* 

NUMBER < 1 PRINT AS F FIELD EVEN THOUGH* 
ACCURACY IS LOST. FILL FIELD WITH * IF* 

number * ii* 
if e < then go to rc* 

else go to ast!* 
end;* 
comment number will fit as e field*adjust parameters so* 

etype can handle!* 

SKIP «■ W«<D+6>I* 
IF (D * D+l) > 8 THEN BEGIN 01*8; D2 * 0-8 END* 

ELSE BEGIN 01*0; D2 * END;* 
PC0)l COMMENT FLAG USED AT REOT TO RETURN CONTROL TO* 

RRTNI* 

go to rein;* 
rrtn* if (d * 0-1) > 8 then begin dl*8| d2 * d-8 end* 

else begin d1*di 02 * end!* 



00255700 
00255800 
00255900 
00256000 
00256100 
00256200 
00256300 
00256600 
00256700 
00256800 
00256900 
00257000 
00257100 
00257200 
00257300 
00257400 
00257500 
00257600 
00257700 
00257800 
00257900 
00258000 
00258100 
00258200 
00258300 
00258400 
00258500 
00258600 
00258700 
00258800 
00258900 
00259000 
00259100 
00259200 
00259300 
00259400 
00259500 
00259600 
00259700 
00259800 
00259900 
00260000 
00260100 
00260200 
00260300 
00260400 
00260500 
00260600 
00260700 
00260800 
Q0260900 
00261000 
00261100 
00261200 
00261300 
00261400 
00261500 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0774*1 
0774*2 
0775*1 
0775*2 
0776*0 
0777*3 
0778*1 
0781*0 
0781*0 
0781*0 
0783*3 

0785*2 
0788*1 

0788*1 
0789*0 

0790*1 
0790*2 
079110 
079l»0 
0792*3 
0795*2 
0797*0 
0798*1 
0799*3 
0800*2 
0801*0 
0803*1 

0803*3 
0806*0 
0806*2 
0806*2 
0806*2 
0806*2 
0807*0 
0807*0 
0807*0 

0808*2 
0808*2 
0808*2 
0808*2 
0810*1 
0810*3 
0810*3 
0810*3 
0810*3 
0811*2 
0812*2 
0812*2 
0812*2 
0812*2 
0814*1 
0818*2 
0821*2 
082H3 
0821*3 
0822*1 
0826*2 



go to comm;% 

MAXMU: $0007777777777777}% 
COMMENT AFTER FORMATING A 



PHRASE WE COME HEREJSS 



commm: buff«-p ; 

commj if code > 2 then whl «- lisx|% 

IF P((FFTYP-0),SU8'DUP) > THEN GO TO INLOOP ; 

PCDEDJ* 

GO TO Si J % 

COMMENT THE <REPEAT PART> OF PHRASE IS IN TOP 
IF REPEAT-1 > THEN GO TO INLOOP TO USE 
AGAIN ELSE DELETE THE "0" REPEAT AND 60 
PICK UP NEXT PHRASED 
END OUTPUTINT;! 



OF STACK.% 
SAME PHRASE 
TO SI TO* 



00261600 
00261700 
00261800 
00261810 
00261900 
00262000 
00262100 
00262200 
00262300 
00262400 
00262500 
00262600 
00262700 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0828*2 
0829*0 
0830*0 
0830*0 
0830*2 
0832*2 
0835*1 
0835*2 
0837*0 
0837*0 
0837*0 
0837*0 
0837*0 



SIZE* 0838 WORDS 



41 



COMMENT ALGOL SELECT INTRINSIC;* 

PROCEDURE ALG0LSELECT(ACT1#ACT2#TANK»I); VALUE ACT1 * ACT2* TANK* li % 

START OF REL 
INTEGER ACT1,ACT2,IS NAME TAN«;% 
BEGIN ARRAY FIBC * 3 ' NAME MEM=>2* ARRAY FPB»3E*H% 
ARRAY HEADER[*3;JS 
LABEL REw*L6*MYUSERR ; 
REAL RITEM2*REEDM3#SEUECTbH;X 

integer status *n8uffs*bsize#t1*in0ut#d i rec»utype;x 
label owt*easy*exit*fill;% 
define i0d=c*tank)#;% 
Label wr*err>RF*rr;% 

LABEL DC19; 
SWITCH CURRENT*WR*ERR*RF*RR;« 
LABEL CR*LP*MT*DK*Sp,cP*PP>PR*DC;3! 
SWITCH USW<- CR*LP*MT*EASY*DK*SP*CP,LP*PP>PR*DC*CR*LP*DC19; 
REAL SUBROUTINE COUNTjX 

BEGIN FOR 1*0 STEP 1 UNTIL NBUFFS^l 00% 
BEGIN IF NOT T ANK [1 3 , [ 1 9 : 1 ] THEN* 

PC [TANK CI H, P2000000000* 2* COM* DEL* DEL ); X 
IF TANKm, [27*13 THEN 
BEGIN 

I * I + 1-CFIBE4J.C2U3 AND F IB[5] , [ 44 * 13 ); 

pc i >; go owt; 
end; 
end; pco>;% 
owt* count*p;% 
end count;* 

subroutine space; pcxch,tank*9*ii,com*del*del*del>;% 
subroutine moveup;% 

IF CI*MEMCFIBC163 INX 13)XBSIZE THEN* 

BEGIN TANKC0]*I0D»(P(DUP).[33I15 3"BSIZE+I)C33»33I153J% 
T1*FIBC16], [33*15];% 

stream cn«-i + i*l*-o*s*ti- i* d*-ti-bsize);x 
begin si*-t.oc n; si«-si+6; di*loc l; di*di + 7; ds*chr;% 
si*s; di*d; ds*n wds; lcds*32 wds; ds*32 wDsm 

END END;* 

subroutine refill;* 

begin for 1*0 step 1 until nbuffs^l d0% 



00300000 
00300100 

segment; disk 

00300200 
00300300 

0030040Q 

00300500 
00300600 
00300700 
00300800 
00300900 
00301000 
00301010 
00301100 
0&3Q120G 
00301300 
06301400 
00301500 
00301600 
00301700 
00301800 
00301805 
00301810 
00301820 
00301830 
00301900 
00302000 
00302100 
00302200 
00302300 
00102400 
00102500 
00302600 
00302700 
00302800 
00302900 

00303000 
00303100 
00303200 



T 0000*0 
T 0000*0 
ADDRESS = 00053 



T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 



0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0001*0 
0005*1 

0007*0 
0009*2 

oonto 

0011*2 
0015*1 
0017*0 
0017*0 
0017*3 
0018*0 
0018*1 
0021*1 
0022*0 
0024*3 
0028*1 
0029*3 
0032*3 
0034*0 

0036*1 
0036*3 
0037*0 



• 
• 



TANKCI 
IF N8U 

begin; 



end end re 
subroutine e 
begin Fien? 

FIQC16 
FIRT19 

FIBC13 
FI8C53 
TANKCN 
BSlZE*- 
FOR I* 
BEGIN 



END END EM 
IF I - 6 THE 
IF l s 7 THEM 
TANK*((I-1 ) 
FlB<-TANKtNOT 
IF 1-4 THEN 
BEGIN^STREAM 

IF FIB 
BSlZE<- 
IF (AC 
IF AST 
IF ACT 
IF ACT 
IF F 



IF 



EASYI 



MT 



PC 
FI 



END ELSE 
IF STATU 
BEGIN FI 



END;* 
GO TO 



CR« LPS CPi 



GO 

US 
NB 
IN 

GO 
PP 



ACT 
BEGI 
REGI 
IFCD 
DIRE 
END 
TANK 
BC13 
THEN 
BEGI 

GO 
S.U 
8C13 

TO 

WCUT 
UFFS 
OUT* 

TO 
S PR 



3«-TANKCl3«lEl9 
FFS >i THEN* 

STREAMCT*-IOO*N 

begin si*d; si 
pc2&cnqt direc 
fill;* 
mpty;% 

>8SIZE-U0D.C 
]«-FlBC16]&0[22 

3«-FlB[193&0[22 
]«-FlB[13]&0[25 

OT 13*P(OUP*LO 
IF STATUS'O TH 

STEP 1 UNTIL 
TANKCI J*TANKCI 

&FI8C1 
IF I>0 THEN* 

TANKE 13* 
ACT2*MEM[ACT2- 
PTYj* 

N GO TO L6; 
GO TO MYUSERR 
INX *PC,TANK)) 
23; STATUS«-FI 
IF STATUS, [42$ 
CS*[FPBCFIBC4] 
BEGIN Sl*Sj DS 
Cl3sO THEN FIB 
FI8[133,C28U0 
Tl OR 4} = 6 THE 
1*4 THEN Tl*e2 

1*8 THEN Tl!*? 
1=0 THEN? 
I8C153.C24J63 
THEN Tl I*ei2 E 
THEN 6 E 

1 * 1 THEN 
N N8UFFS:=8SIZ 
N Hf[AOER: = *CFI 
IREC» B FIBC73-1 

c:=inqut; INOUT 

END ELSE Tll«0 
ST 1 C 18 * 33 S 153, 

]. 128110] tsiF 

FI8C13 ELSE N 
N FI8C6] :=IN0U 
TQ EXIT ELSE* 
1!2]*0 THEN% 
3<-Fl8C 13 3&C ACT 
EXlTJ% 



U7U34DIRECC22U7I13 OR MEMJX 
*N8UFFS*l»D*-TANKm 

*si+e; ds*n wds; si*loc t; ds*wds end;* 

HH47«i3*TANK#10Ml'C0M»DEL*DEL*DEL?;* 



33H5]-(STATUS»3)-ACT2*riBtl6 3,C33il5]); 
*22:i3&0[24:24!13;% 
?22J13&0C24$24J23;% 
* 25: 11&0C27J 27: l ] ?% 

0)40 [22 1221 13&0C24I2AU3>% 

EN MEMUCT2-U ELSE IOD, E8» 103;% 

NBUFFS-1 DOX 
Ul[l9U7llH0t22l22tl]40C2/H24UJX 
8318:388103 OR MEM;* 

TANKCn&((STATUS = 3) + ACT2)C33?33U53l% 
23.[18ti53)X 



&0[8:8J253U 

BC53; UTYPE*FIBU3,[8U3;% 

13*0 THEN% 

.C13*ll]+213*D*CNBUFFSn;% 

*3 oct end;* 

Cl3:*NBuFFS; 

1}% 

N Tl+912 ELSE* 

2 ELSE* 

52 ELSE 

LSS 16 AND NBUFFS GTR FIBC13 
LSE TllalF NBUFFS EQL BSIZE 
LSE (?12 ELSE 

E; Ti:*7; IF UTYPE * 4 THEN 

BCU33; 

) GTR ( IN0UT?=HEADERC73) THEN 

:*(DIREC DIV HEADERC03.t30:i23)+U 

* 
9 

6,h,com#del*ded;% 
fibc153. [24:63 lss 16 and not actt 
buffs; if actl and utype *4 then 
t; fib[73 jsDirec; end; go to exit; 



2 = 3)[25:47U3&(ACT2XQ)t27$47$l];S 



ype];* 

*FIRC133.C10»9 

ACT2*Q; DIREC* 

currentcfibc53 
j go to err; 



3; BSIZe*FIB[183,[18:153;% 
ACT2=3; STATUS*STATUS,t46*2];X 
,£43:23];% 



00303300 


T 


004l» 


1 


00303400 


T 


0046> 


2 


00303500 


T 


0047S 


1 


00303600 


T 


0049« 


3 


00303700 


T 


00511 


2 


00303800 


T 


0054> 


3 


00303900 


T 


0055! 





00304000 


T 


0055' 





00304100 


T 


0059« 


2 


00304200 


T 


0063! 


3 


00304300 


T 


0067« 


1 


00304400 


T 


0070! 


3 


00304500 


T 


0073' 


1 


00304600 


T 


0077! 


1 


00304700 


T 


00821 





00304800 


T 


0086! 


1 


00304900 


T 


0090< 


1 


00305000 


T 


00931 


t 


00305100 


T 


0094! 





00305200 


T 


0098' 


1 


00305300 


T 


OlOil 





00305400 


T 


01011 


3 


00305410 


T 


0105! 


2 


00305500 


T 


0106! 


3 


00305600 


T 


01091 


3 


00305700 


T 


011ft! 





00305800 


T 


0116! 


2 


00305900 


T 


0119 


! 2 


00305950 


T 


0120! 


1 


00106000 


T 


0123! 





00306100 


T 


0124! 


2 


00306200 


T 


0127! 





00306250 


T 


0129! 


»2 


00306300 


T 


0132' 


10 


00306350 


T 


0133 


n 


00306400 


T 


0135 


53 


00306500 


T 


0138 


! 2 


00306600 


T 


0141 


SO 


00306610 


T 


0142 


!1 


00306620 


T 


0145 


10 


00306630 


T 


0146 


13 


00306640 


T 


0149 


!2 


00306650 


T 


0153 


'1 


00306700 


T 


0154 


12 


00306800 


T 


0156 


!2 


00306805 


T 


0159 


SO 


00306810 


T 


0164 


10 


00306900 


T 


0167 


'2 


00307000 


T 


0167 


'2 


00307100 


T 


0169 


'I 


00307200 


T 


0174 


»1 


00307300 


T 


0174 


»3 


00307400 


T 


0174 


»3 


00307500 


T 


0182 


»3 


00307600 


T 


0186 


»0 


00307700 


T 


0189 


«3 


00307800 


T 


0193 


*2 



$ SET OMIT = NOTCTIMESHARING) 
DC* 

J POP OMIT 
DC19I POLISHCIOD, CTANKC133, *P<DuP), TANK, «•, 
FIB[53 * C*PCDUP))&P(DUP# LNG H 43 J 43 : 1 3 ; 

* SET OMIT = TIMESHARING 



o; 

GO 



to easy; 



Wr: 
ERR 
SPI 
RF? 



• 
• 
• 



FILL' 



RR* 



IF NOT DIREC THEN 

PCTANK,8,11>CQM);X 
P(MKS,l,0»CNOT 2) INX TANK* Up SELECT ) J GO TO EASYU 
IF INOUT TH£N% 
BEGIN Tl*-COUNT; P(C-I))J SPACE?* 

IF CI^MEMCFIBCiei INX NOT 0})*BS1ZE THEN* 
BEGIN;StREAM(NM + 1,NDIV64«-CI + 1) DIV 64*% 

S«-FIBEl63 INX (NOT 0) INX I»X 
D«-FIBU63 INX (NOT 0) INX BSIZE);* 
BEGIN Sl*S; NCDS^WDS; Si«.Si-16; DI + DI-16)** 

NDlV64(2C32C0S<-wDS; SUSI-16/ DI«-Dl-16 ) ) )|X 

end;* 

tankc03«'(bsize-i) inx loo;* 
end;* 
fibc 17]*-i-c if fibc173*0 then i else fibe173)* 

+{STATUS*0)xI00.E8»l03*<STATUS*3);* 
FIBC163 + CBSIZEM) INX FIBC 1 63U C 22 * 47 1 n ; % 
FIBC19]«-FlBC193&Cri8fl6] INx (STATUS/3)* 

-CSTaTUS*1)xfIBC18 3,C33*15 3H33*33*153* 
4CIF STATUSsO THEN FlBE 193 . C 3 85 3 +2 ELSE* 

IF STATUSsl THEN 5 ELSE 7 ) C 3 * 43 * 5 3 &1 E22 * 47 *1 3 ;5 
FIBE53.C43J234-3; FlBCl33,C25*13*i;* 
TANK t NOT 13<-P(DUP*L0D)&1C22 847$13;% 
HEMCFIBC16] INX 13*I>% 

memcfibc163 inx not c 1-1 ) 3*1 ; % 

refill;* 

p cmks, 0,1, tank, reed, mks, 0,0, tank, reed);* 

ELSE* 



END 

BEGIN 



IF COUNT THEN IF 1*1 THEN* 

BEGIN P(MKSM,0,<NOT 23 INX TANK, 4* SELECT 3 ; * 

FIBC133,C25?13 < -1;* 

PCTANK, 0,11* COM, DEL, DEL);* 

P( MKS, AC T1,0,TANK,1, SELECT};* 

GO TO exit;* 



end;* 
pct-i)); 



space; empty;* 



end;* 

go to exit;* 

if inout then* 

begin ti«-count; pen; space; moveup;* 

FIBC173M-CIF FIBC 173 = THEN I ELSE FIBt 1 7 3 ) + C ST ATUS=3 )% 

+(STATUS^O)xIOD,r8*l03;* 
FIBC 163*FIBC 16 34P(0UP»1*INX# BSIZE,- )[ 33 » 33 1153 &0C22«22ll]J% 
FIBC193<-FIBC193&(FI8C163 INX ( STATUS*3 ) ) [ 33 * 33 8 15 3 &0C22 I 22 * 1 3* 

&(P(DUP).C3:53-STATUS&(NOT ST ATUS ) C46 : 46 * j ] ) [ 3* 43 *5 3 ; * 
TANK I" NOT 13<-P(DUP,L0D)&0C22J228 13;* 
FI8C5 3 • C43:23*2; FlB[133,C25813«-0; GO FILL;* 

end;* 

IF COUNT THEN IF 1=1 THEN* 

BEGIN P(MKS,0,0,(NOT 2) INX TANK, 4, SELECT ) ,* GO TO EASY END;* 

Pci-n; space; moveup;* 



00307801 
00307805 
00307808 
00307810 
00307820 
00307825 
00307900 
00308000 
00308100 

00308200 
00308300 

00308400 
00308500 
00308600 
00308700 
00308800 
00308900 
00309000 
00309100 
00309200 
00309300 
00309400 
00309500 
00309600 
00309700 
00309800 
00309900 
00310000 
00310100 
00310200 
00310300 
00310400 
00310500 
00310600 
00310700 
00310800 
00310900 
00311000 
00311100 

00311200 
00311300 
00311400 
00311500 
00311600 
00311700 
00311800 

00311900 
00312000 

00312100 
00312200 
00312300 
00312400 
00312500 
00312600 
00312700 

00312800 
00312900 



019410 
0194*0 
0194*0 
0194*0 
0l96»2 
0199*3 
0199*3 
0200>t 
0202*0 
0204«3 
0205*0 
0209*0 
0212*0 
0214*3 
0216*2 
0218*2 
0220*1 

0222*3 
0223*0 
0225*0 
0225*0 

0228*2 
0232*2 

0236*0 
0238*1 
0240*3 
0244*1 
0248*3 
0253*3 
0256*3 
0259*0 
0262*0 
0263*0 
0265*2 
0265*2 
0268*1 
0271*0 
0273*2 
0275*0 

0276*2 
0277*0 

0277*0 
0280*0 
0280*0 
0280*2 
0280*3 

0285*0 
0289*2 

0292*2 
0296*2 
0299*2 
0304*0 
0307*0 

0312*2 
0312*2 

0315*1 
0318*2 






# 



% 

DK* 



REW:% 



L6S 



Fl8Cl6l«-Fl8C163&PC0UP,l,INX,BSIZE,-)t33J33U5 3n 
FIBC193 + CSTATUSB3) INX F IB [ 16 3&FI BE 18 3 [8 8 38 ! 10 3 ? SS 

EMPTY;* 

p(mks.0,0*0>c-1)*tank, r ite, mks* 0, 0, 0» bsi ze>t ank, rite);* 
go to exit;% 

IF FlBC43.C27s3]sl THEN% 

begin fibc53.ca3i23*act2J% 

fibc163,c24!13*act2«-act2/0jx 

FIBC19]*FlBC19 34ACT2C24l47li]«0t 251 47113* 

END ELSE? 

IF FIBU3.C27:3]=0 THEN* 

BEGIN IF ACT2sl THEN ACT2*F IB C5 ] . [ 43 1 23ELSES 
IF ACT2=4 THEN ACT2*0 ELSE* 
IF ACT2s3 THEN ACT 1 + F IB 1 7 ] - 1 ELSE% 
IF FIBC53, [43:23 = 3 THEN ACTl«-FIBC 73 + 1 ELSE* 
ACT1«-FIBC73;« 

P(MKS,0*0, (NOT 2)INX TANK* 4, SELECT ) }% 
FIB[l33«-FlB[133&(ACT2 = 3)[258 478l3&CACT2*QH27S47?t3;X 

ClBC7]«-ACTU* 

pctank,omi>com,del»ded;* 

END ELSE* 

BEGIN IF ACT2=3 THEN GO TO ERR;% 

IF ACT2=1 OR ACT2s4 THEN GO TO REW/% 

IF ACT2=0 THEN BEGIN HEADER** [FI B [ 14 3 3 t% 

IF FIB[73>HEADERC73 TH£N% 

HEADER[73«-FIBC73U 
PC MKS*0'1*TANK,REED*MKS>0#Q* TANK* REED); 
END ELSE* 
P(MKS*l>0»0*Cl )*TANK*RITE** 

MKS*l»0*Q*FlBE183,C338l53*TANK*RIT£);% 

GO to exit; 
end; go exit; 

FIB «- *TANK; TANK «-CTANKC333; 
IF ACT1 = 1 THEN 

BEGIN % I/O COMPLETE BUT NOT PRESENT 
IF NOT C*TANK), [27813 THEN % PARITY 
PU*[TANK[N0T 233*19, 17»C0M) 
ELSE 

8egin % eof or eor 
pctank*h*h, com, deluded; % Read 
if mem[tank[not 13 inx 43. [42863 *0 

Tl<- FIB[133,[28*103 + 1 ; % REEL # + 
P(MKS* 4*0* [TANK [NOT 2 3 3 ,4, SELECT ) ; 
FIBH33. [285103 * Ti; 

pc [tank], 0,11, com); p(0,rtn); 
end; 
end; 
if actl a then % reel switch on output 

BEGIN 

HEADER «• TANK[NOT U; HE ADERt 4 ] . [ 42 J 6 3 * II % EOR FLAG 

Tl *■ FIBC131. [288103 + i; 

P(MKS, 7,0, [TANK [NOT 2 3 3 , 4, SELECT ) ; 

FIB[133,[288103 «■ T 1 J 

p( tank, 0,11, com); pcxit); 
end; 



% SORT REEL SWITCHING 



* TERMNATE ON PARITY 



ENDING LABEL 

THEN PC 1*RTN); 

1 

X CLOSE PURGE 



%EQF 



00313000 
00313100 
00313200 
00313300 
00313400 
00313500 
00313600 
00313700 
00313800 
00313900 
00314000 

00314100 
00314200 
00314300 
00314400 
00314500 
00314600 
00314700 

00314800 
00314900 

00315000 
00315100 
00315200 
00315300 
00315400 
00315500 
00315600 
00315700 
00315800 
00315900 
00316000 
00316100 
00316200 
00316300 
00316400 
00316500 
00316600 
00316700 
00316800 
00316900 
00317000 
00317100 
00317200 
00317300 
00317400 
00317500 
00317600 
00317700 
00317800 
00317900 
00318000 
00318100 

00318200 
00318300 
00318400 
00318500 
00318600 



T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



032180 
032480 

032783 
032980 
033283 

033311 
0333«1 
033582 
0338*2 
034280 
0345*2 

034582 
034782 
034880 
0350*3 
0353*1 
356 8 2 
0360*2 
0362*0 
0364*1 
0368*3 
0370*0 
037182 
0371*2 
037381 

0375*3 
0378*1 
0379*2 
0381*2 
0384*0 
0384*0 
0386*2 
0389*0 
0389*2 

0390*0 
0392*1 

0393*0 
0393*2 
0394*3 
0397*1 
0397*1 
0397*3 
399*1 
0403*3 
0405*3 
0408*0 
041012 
0412*0 
0412*0 
0412*0 
0412*3 
0413*1 

0417*2 
0419*2 
0421*3 
0424*1 
0425*2 



m 

# 






© 



• 



IF ACT1 * 2 THEN 
BEGIN 

Tl * IE 

P(MKS«.Tl 

END* PCX IT 

MYUSERRl %%% BRANCH TO 

PCTANKCNOT 33)* T 

FIB<-TANKCNQT 23/ 

STRFAM(Pl«-ACT2/P2«. 

BEGIN DS«-5UT 

DS«-LIT"/"; T 

TALLY«-TALLY + 1 

DS«-7l_ir\MYUS 

SI«-LOC Pll S 

END OF STREAM 

PC CHEADERC03 3 . C33s 

EXIT:?* 

end select;? 



X REWIND OUTPUT 

FIBC13], [281101 = 1 THEN ELSE 7t 
/0/[TANK[NQT 21 3 *H> SELECT ) ; P(XIT); 
)/ ' 

HERE IF 1*7/ 
ANK[NOT 33*TANKCNOT 4J*0I P CMKS, 9/ JUNK/ DEL ) / 
HEADER*P(CHEADER[i13#CFX/SFB) & 1QE8*38*103 J 
[FP8[FlBC43,U3:tlin,P3«-FlBt5J.[li:2j,HEADER) 
M -FAE( N / Sj>P2j Sl*SI + i; DS*7CHR; SJ>SI + H 
ALLY«-0; 7C IF SC = " " THEN JUMP OUT; SI*Sl + U 

); si<-P2; si*si+9; P2*tally; ds*P2 chr ; 
e* m ; si<-loc P3; ds*dec; ds«-8lit«m tried « ; 
i«-si+2; ds<-6chr; ds«-2lit"««." ; 
; 

153/34/COM) ; 



00318700 
00318800 
00318900 
00119000 
00319100 
00319110 
00319120 
00319130 
00319140 
00319150 
00319152 
00319154 
00319160 
00319170 
00319180 
00319190 
00319200 
00319300 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SIZ 



0425*2 
0426*1 
0426*3 
0430*1 
0432*3 
0433*0 
0433*0 
0438*2 
0442*3 
0446*1 
0448*1 
0450*2 
0452*1 

0455*1 
0456*2 
0456*3 
0458*1 
0459*0 
E s 0460 



• 



PROCEDURE INTRINSICCDUPE/D/NUMDlM/SIZE/TYPE);% 

START OF REL 
VALUE DUPE/D/NUMDIM/SIZE'TYPE;* 
ARRAY DUPEt*i;NAME Oj% 
INTEGER NUMdIM/SIZE#TyPE;% 
BEGINS 

NAME DUM=TYPE*A;% 
ARRAY D0PE=-8C*1/X 
ARRAY PRTP0INTER*10C*)I% 

REAL NUMBUFFs-7/l0T=-2/M0DE=-6/FILEN0s-9/BUFFSlZE="5;X 
REAL DISP0SITI0Ns-10/R0WSlZE B -ll/NUMR0WS=""12/RECSlZE*0n 
NAME E;% 

INTEGER I»J*KJX 
REAL C!% 
BOOLEAN B>% 
ARRAY AIT«6t*]i% 
REAL RECURSE*5; INTEGER BLQCKCTR=l6; % 
NAME M«2; 

ARRAY FIBC*3; 
ARRAY FPBs3C*3/SEGDlCT=4[*]; 

INTEGER TlPE = -2/CYCLE*-3/DATE*-4/REEL = -5/FID**6/MFI0*-7/* 

NAME FLEs-8; 
LABEL EXIT/AOK/UPdATEFPB; 
REAL PTR=-ll»APTR=-lO,L80=-7/DIM0--6»LBN*-5/OlMN=-4/MAXLB/MINUB/ 

ubq/ubn/N/TP/h; 
array arry = minub03/ 
integer dim! = ubo/ dim? e ubn/ 
array 0at s 11c*3*new=-8c*3/0ld=-9[*1; 

NAME MAT=-2/NAT; 

BOOLEAN OWNTOG/REDECLTOG/TASKaRRAYTOG/AUXTOG; 

LABEL FOUND/ARR0UNDFOUND/TY12; 

NAME PHILE=-10; 

LABEL TY0/TYi,TY2*TY3/TY4/TY5*TY6/TY7/TY8»TY9/TYl0U 

LABEL TY11/TY13/TY14/TY15/TY16,TY17/TY18/TY19; 



00400000 


T 


0000*0 


SEGMENT! DISK 


ADDRESS * 


00400100 


T 


0000*0 


00400200 


T 


0000*0 


00400300 


T 


0000*0 


00400400 


T 


0000*0 


00400500 


T 


0000*0 


00400600 


T 


0000*0 


00400700 


T 


0000*0 


00400800 


T 


0000*0 


00400900 


T 


0000*0 


00401000 


T 


0000*0 


00401100 


T 


0000*0 


00401200 


T 


0000*0 


00401300 


T 


0000*0 


00401400 


T 


0000*0 


00401500 


T 


0000*0 


00401600 


T 


0000*0 


00401700 


T 


0000*0 


00401800 


T 


0000*0 


00401900 


T 


0000*0 


00402000 


T 


0000*0 


00402100 


T 


0000*0 


00402200 


T 


0000*0 


00402300 


T 


0000*0 


00402310 


T 


0000*0 


00402320 


T 


0000*0 


00402400 


T 


0000*0 


00402500 


T 


0000*0 


00402600 


T 


0000*0 


00402700 


T 


0000*0 


00402800 


T 


0000*0 


00402900 


T 


0000*0 


00403000 


T 


0000*0 



i 

i 



i 
i 



WORDS 



00069 



A«-P 



IF 



• 



ARR 
AOKJDO 



SWITCH SW*TY0*TYi*tY2»tY3»TY4*tY5» 
TY12,TY13^TY14,TY15*TY16 

TASKARRAYTQG*TYPe.[1«13JAUXTQG*TYP 

GO TO SW[TYPE3;« 
TYO* STY1«TY2JTY3J% 

OWNTOG«-TYPE, [46*13; 

I<-AITrj<-0 3;TYP£«-TYPE + 4;% 
CNUMDIM-1+OWNTOGX<NUMDIM"1)#NOT*[NUM 
C SIZE- 1+GWNTQG, NOT* CE3, INX)HF P(tEt 

E t03> 

OWNTOG THEN BEGIN 

H<-OATtO];NAT*P(0#NO 
FOR K*i STEP 1 UNTI 
IF AtJ]»tCF3sOATCK3 
FOR C*l STEP 1 UNTI 
0AT[H*H + 13«-0&A[ 
FOR C*l STEP 1 UNTI 

p(nat[c«-13#[oat 
oatco]*h;go aokj 
found:redecltqg«-true; 

stream cr«-o a numdim»a*coatctp*k 
begin si*a;tacly*i; 

NUMOIMCIF 16 SC*DC 
END; 
IF PCNOP) THEN GO TO EXIT; 
OUNOFOUND? A[J]«.[PRTP0INTERC17]3; 
ENDi 



TY6»TY7*TY8*TY9»TYlO*TYll# 

#TY17#TY18*TY19; 

E,t41llliTYPE*TYPE AND $77} 



DIM],INX)J 

033#DUP#LOD#XCH*ISN)<0 OR 
1023 THEN 
PCEC03>TRUE»1#29#C0M>* 

T*CE3#INX); 

L H DO 

• C1U53 THEN GO TO FOUND; 

L SIZE DO 

C-13 [1*33*153; 

L 2XNUMDIM DO 

[H«-H + 133#ISD>; 



+ SIZE 33#8<-£NAT3 )i 
THEN TALLY*0); R*TALLY l 



BEG 
B*NUMDlM 

IF NOT 



P(MKS*FL 

END 

UNTIL (( 

IF REDECLTOG 

BEGIN %R 

P(MKS,TP+2*2*M[0ATCK3, 



» R 

D 

IF 

STR 

end; ait 
; go to exit;% 

TYfl**TY5*TY6J 
OWNTOG*T 
IF P(D*DUP»LOD'XCH 
); DO 



IN% 

xi;c* 

WNTOG 
AIT 
&NU 
IF 
IF 
AtfCC) 
TYP 
% 

J«-J + l 
THEN 
EMAp 
C 1 : 15 
ATCTP 
ECURS 

el>;k 

J<SIZ 

EAM(N 

BE 
[03*1 



{(IF AUXTOG THEN 3 ELSE (TYPE, [47*13 OR 8)5 
&ACJ3CCTF3 I E[03[8*38*103);% 

Then 

CI*I + 13*C & TYPEC2U6I1UBL0CKCTR[8*38!10J% 
MDIM[ 3:43*5 3; P(FLAG( C ) * AC J 3 * STO ) J % 

TASKARRAYTOG THEN AITCI3.CHZ3 * 3/ 
B THEN% 

,tEtl+OWNTQG]3»NUMOIM-l>EtO]# 
ESAUXTOGC41J475l3*RECURSE) * 

)=SIZE) or redecltog; 



33»CPRTPOINTeRC1733*LOD* 

3»0AUTP+13,NAT[03>NAT[13»NUMDIM,[NAT3#12 
E*CM(:OATCK3,tl«l53 3 3*LOD»NUMDIM»25»CQM#DEL* 

*k+.i; 

e then go arroundfound; 

umdim*a*-tnat[0 3 3#b«-coatctp3 3); 

gin sua;numoim(os«-2 wds) end; 
;go to exit; 



TY7l% 

YPE.C46U3; 
j»ISN>DUP )S0 

BEGIN* 



OR P(XCH)>1023 THEN P(DC03 $ 1 1 \ t29# COM 



00403100 


T 


000010 


00403200 


T 


0000*0 


00403250 


T 


0000*0 


00403300 


T 


0008*3 


00403400 


T 


0019*3 


0&4035OO 


T 


0020*0 


00403600 


T 


0021*1 


00403700 


T 


0024*0 


00403800 


T 


0027*2 


00403900 


T 


0031*3 


00404000 


T 


0032*3 


00404100 


T 


0034*2 


00404200 


T 


0035*1 


00404300 


T 


0037*3 


00404400 


T 


0039*0 


00404500 


T 


0044*2 


00404600 


T 


0046*0 


00404700 


T 


0052*3 


00404800 


T 


0057*0 


00404900 


T 


0060*3 


00405000 


T 


0062*2 


00405100 


T 


0063*1 


00405200 


T 


0066*1 


00405300 


T 


0066*3 


00405400 


T 


0068*2 


00405500 


T 


0068*3 


00405600 


T 


0069*3 


00405700 


T 


007i»2 


00405800 


T 


0071*2 


00405900 


T 


0071*2 


00406000 


T 


007i«2 


00406100 


T 


0075*2 


00406200 


T 


0078*1 


00406300 


T 


0078*3 


00406400 


T 


0082*1 


00406450 


T 


0086* 1 


00406500 


T 


0089*2 


00406600 


T 


0089*3 


00406700 


T 


0093*1 


00406800 


T 


0094*3 


00406900 


T 


0094*3 


00407000 


T 


0097*2 


00407100 


T 


0097*3 


00407200 


T 


0098*1 


00407300 


T 


0102*0 


00407400 


T 


0105*1 


00407500 


T 


0108*2 


00407600 


T 


0110*0 


00407700 


T 


0111*1 


00407800 


T 


0112*3 


00407900 


T 


0114*1 


00408000 


T 


0116*0 


00408100 


T 


0116*2 


00408200 


T 


0117*0 


00408300 


T 


0118*1 


00408400 


T 


0122*3 


00408500 


T 


0123*0 



• 
• 



c 



B*NUMDIMXi; 

DUPECK]*FLAQ(C*CCIF AUXTOG THEN 3 ELSE 

(TYPE, C47M3 OR B))X 
&[DUPECKJ J[CTFHD[OH8!38U03)>;z 
IF 8 THEN% 
PCMKS#FLAGCC)»CDEl+OWNTaG3 3#NUMOIM-l,OC03* 
TYPE4AUXT06C41«47il3»RECURSE) * 
END* 
UNTlL(K*K+l)sSlZE% 



GO TO exit;* 



TY12* 



IF LBO<LBN 



• 
• 



UBO«-LBO + D 
UBN<-LBN + D 
IF UBCXUB 

N*MINuB"M 
IF NUMDIM 
IF N<0 TH 
STREAMCN, 
BEGI 



FOR 1*0 S 

P(MK 

[NE 

MAT 

GO T 

TYR* 1% 

PCIF 
PCNU 
P(RE 
PCBU 
PCRO 
IF P 



MAXLB«-LBN 
MAXLB«.UBOi 



MINUB<-UBO 
MINUB*UBNJ 



then 

else 
imo-i; 
imn-i; 

N THEN 
ELSE 
AX.LB + 1J 

*t THEN BEGIN 
EN GO TO EXIT; 
M*N,[38t4]#A«-[QLDCMAXLB-LB03]#B«-[NEWEMAXLB-LBN]])| 

n si«.a;m(ds*32 wds;ds«-32 wds);ds«-n wds; end; 

END 
ELSE 

TEP 1 UNTIL N-l DO 

S#PTR + 2*APTR + 2*[0lDtMAXLB-LB0 + n3#L0D# 

WCHAXLB-LBN+I3 3#LOD»OATtPTR3^0ATCPTR+13» 

CAPTR3#MATCAPTR+t3#NUMOlM-i,CMAT3»12»RECURSE)i 

o exit; 



numbuff<1 then 1 else numbuff, .numbuff* iso); 
mdim#,numdim#isd); 

CSlZE*,RECSI2E^IS0>; 
FFSIZE'.BUFFSIZEMSD); 
WSIZE*.R0WSIZE*ISD); 
(NUMR0WS*,NUMR0WS#ISN)>20 THEN 

P(NUMR0WS*TRUE#2*29^C0M); 

P(MKS**P(,D0PE)#(NUMBUFF*l)+NUM8UFF+27# 
1>1*1#RECURSE); 

AIT[AITC033*-AIT[AITC033;% 

D0PE«-*C00PE3;% 

DOpE[23«-tDOPEE(NUMBUFFBl)+NUMBUFF + 53 38i22t8J38»l03; 
C43«.[DOPE£533J% 
£33<-OUO!:8S388l03;% 

I*0;C* 020002020000000 &CIOTX10)C24?47!13&MODEI 

C27:47?n&CCD0PEC633)[CTC3;% 

WHILECK-I + DSNUmBUFF DOX 

00PE[I + 43«-FLAG(C);X 

00PE**C0QPE[233U 
AM(T*CNUMDIM3); BEGIN S)>TJ OS «• 8 DEC END** 
NO*CFlLEN0-l)xETRLNG;% 
C*3*NUM0IM&FILEN0tl3t37lll]«lC12»47in*3tai44M3X 

*(I0Tall)[6l47«n40lSP0SlTI0NC25l46l23;-X 
ECStZE=0 THEN* 
N RECSIZE«-BUFFSjZe; 1*0 END ELSE* 

uffsize<recsize then* 

n ubuffsizf; buffsizf«-recsize; recsize*i; i*i end% 



DOPE 
DOPE 



STRE 
FILE 
DOPE 

IF R 
BEGI 
IF B 
BEGI 



00408510 
00408600 
00408700 
00408800 
00408900 
00409000 
00409100 
00409200 
00409300 
00409400 
00409500 
00409600 
00409700 
00409800 
00409900 
00410000 
00410100 

00410200 
00410300 
00410400 
00410500 
00410600 

00410700 
00410800 
00410900 
00411000 
00411100 
00411200 
00411300 
00411400 
00411500 
00411600 
00411700 
00411800 
00411900 
00412000 
00412100 
00412200 
00412210 
00412300 
00412400 
00412500 
00412600 
00412700 
00412800 
00412900 
00413000 
00413100 
00413200 
00413300 
00413400 
00413500 
00413600 
00413700 
00413800 
00413900 
00414000 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0123*0 
0124*1 
0126*1 
0127*2 
0130*2 
0130*3 
0134*1 
0135*3 

0135*3 
0137*0 

0138*2 
0138*2 
0139*3 
0141S3 
0143*2 
0145*1 
0146*2 

0148*2 
0150*1 

0151*2 
0152*3 
0156*1 

0158*2 
0158*2 
0158*2 
0163*1 
0166*3 
0170*0 

0174*2 
0175*0 
0175*0 
0177*3 
0178*2 
0179*1 
0180*0 
0180*3 
0182*0 
0183*3 
0186*1 
0187*1 
0189*2 
0190*3 
0194*3 
0196*1 
0198*2 
020i?0 
0203*1 
0205*2 
0209*0 
0210*1 
0211*3 
0213*2 
0216*2 
0220*1 
0221*0 
0223*0 
0224*1 



•» • 



DO 



• 



$ SET 



t 

• 



ST 

BE 
DO 



DO 

DO 

OMIT = NO 

GO TO E 

TY9* i% 

BE 



DO 



EN 

NU 

GO TO E 

TY10I ix 

A J, 

GO TO E 

TYllil FIB«-FLE 

IF FIBC 

IF FIBC 

IF FIBC 

IF FIBC 

MFIB + 

UPDATEFPB* 

BEGIN 

ST 



BE 
2( 



PEC5UI & (IOT/lO)U3847*13 & 1C*2«47I 1 3 & (IF TYPE*( 
TYPE*FPBtFlLEN0 + 3].t43i5])sl OR TYPE*4 OR TYP£~6 
OR (TYPC>1« AND TyPE<19) THEN 2 ELSE 3M11U6I23 
& (IF TYPE THEN ELSE 3M9S46*23 & (IF TYPE THEN 
4 ELSE OU13U5I3] i 

REAM(FB*CFPBCFILEN03 3,R«.CI3);X 

GIN SI*FB; SI*SI+16; DS*3 OCT ENDU 

PECl3]*04NUMBUFFCl»39:9]4M0DEC24IA7inX 
&IC28l38*l03&NUMBUFF C 10 » 39 S 9 3% 
&C IOT^IO )C27 Sft?M 3;X 

pee 18]«.re.csize&buffsize[ 3! 331 15hbuffsizec 18133115m 
pec8 3*r0wsize4numr0wsc15*38*103;% 
t sharedisk 
xit;% 

GIN IF NUMDIM i THEN 

IF NUMDIM / 15 THEN BEGIN 

IF (J ♦ (C * NUMDIM). C8U0]) * BLQCKCTR THEN* 
BEGIN BLOCKCTR «■ J + i;% 
P<10»C0M)J* 

end;* 
p(size» ,numdim»*);% 
if (j «• c. [18*1533 ■ then* 

J <• PRTP0INTER,Cl8:i53+2;% 
UNTIL <*(PRTP0INTER4CJ*HUNTCJ + 1) INX ) [ 33 i 33 U5 3 ) > ,% 
C 1 53 3=4 AND MU3»C6*123 KOi 
P((*CPRTP0INTERCC,C33«15]3 3)&JC18J33J153»BRT);X 
D ENDi* 

mdim«-o; 
xit;* 



*--28lC8?38tl03&CSlZE3Ci8:33?l5] JX 



T t AIT C03*-AIT T03 + 1 3 

XITJ% 

CNOT 23; 

53.C41S23 = THEN GO To EXIT; % FILE OPENED 

53.U2I1] THEN GO TO UPDATEFPBJ % CLOSED* RELEASED 

43.C24J23 t 1 THEN GO TQ EXIT; % REWOUND 

43.C8J4] t 2 THEN GO TO EXIT; X MUST BE TAPE 

TIPE «• -O; % PREVENT CHANGE IN MFID OR TYPE 



IF 
IF 
IF 

IF 
ER 
IF 

IF 



REAM(A+0 
CYC 

F* 
GIN SI+L 

IF SC="+ 

IF SC* M 

JUMP OUT 

SC="+" 

SC5"+" 

SC = ,, + " 

SC/"+" 

Ht end; 

P THEN 
REEL>0 



*mfid>fid,reel«-reel*-reel*date*date*date# 
le<-cycle«-cycle,tipe«-tipe*-tipe» 

I*- CFPBCFlBC43,tl3?11333); 
OC mfid; 

" THEN BEGIN SI*Sl+8; DI*DI+8 END ELSE 

" THEN DS*WDS ELSE BEGIN TALLY*!; A*TALLY; 

TO ERR END); 
THEN BEGIN SI*SI + 8| DI*Dl + 3 END ELSE DS«-3 DEC; 
THEN BEGIN Sl*Sl+8; DI*DI+5 END ELSE DS«-5 DEC; 
THEN BEGIN SI s »SI + 8; D I * *DI + 2 END ELSE 

BEGIN DS«- DEC/ DI*DI+1J END; 

SI«-Si + 7; DI«-DI+5; DS*-CHR END/ 



THEN BEGIN 



P((-75)»3<MC0M); % DS - INVALD FILE NAME 
THEN FIBE13].EZ8*103*REEL END; 



00414100 
00414200 

00414205 

00414210 

00414215 

00414220 
0041430Q 
00414400 
00414500 
00414600 
004J4700 
00414800 
00414900 
00414949 
0041500P 
00415100 

00415200 
00415300 
00415400 
00415500 
00415600 
00415700 
00415800 
00415900 
00416000 
00416J00 
00416200 
00416300 
00416400 
00416500 
00416600 
00416700 
00416800 
00416900 
00417000 
00417100 
004J7110 
00417120 
00417125 
00417130 
00417140 

00417150 
00417200 
00417300 
00417400 
00417500 
00417600 
00417610 
00417620 
00417700 
00417800 
00417900 
00417910 
00418000 
00418100 
00418110 
00418200 



0227*3 
0229*0 

0232*1 
0236»0 
0240*3 
0244*1 
0247J0 

0248*1 
0249*1 
0251 '1 
0253*1 
025610 
0258*3 
026H0 
0261*0 
026i»2 
0262*0 
0262*3 
0264*2 
026613 
0268*2 
0269*0 
0269*0 
0269*3 
027i*2 
0274*0 
0277*0 
0280*3 
0282*3 
0282*3 
0283*2 
0284*0 
0284 10 
0288*3 
0289*1 
029113 
0293*3 
0295*2 
0297*2 
0299*2 
0301*0 

0301*0 
030i*0 

0303*3 
0305*1 
0307*1 
0307*2 
030910 
0310*2 
311*1 
0312*3 
0314*1 
0315*2 
0316*0 
0317*1 
0317*2 
0319*0 



{J 
# 



• 



go to exit; 



I* PCIjiLOD) INX 0' % MARK MFIQ OF REMOTE FILE 

IE MCI INX 33,C«3l5]ei9 THEN % WHICH HAS BEEN FILLED 
Mtl3* PCDUP*L0D*SSN3; % SO FILE OPEN WILL KNOW 

GO TO exit; 

TY13** OU I*AlT£j«-03; 

DO AITCI«-I + 13<-CMCCTYPE3INX NOT C 3 HBLOCKCTR [8 J 38 * 10 ] 
&1U*46*23 UNTILCC*C + 1)> SIZE; 

AiTto3*i; go exit; 

TYU*S IF TIPEO THEN TIPE+O ELSE IF TIPE>5 THEN TIPE*5; %AS 

IF TlPE*0 THEN DO % DECLARE SORT FILES XAS 
BEGIN P(MKS*0,0,3,CYCLE + I,CDn3 3,2,l*lO*0,3,ll,8,RECURSE 

*0m»5,CDC*Pl6l2-I,O; XAS 

END UNTIL CI*I+1)5TIPE; SAS 

PCTIPE*RTN); %AS 

COMMENT TY14 DECLARES SORT TAPE FILES FOR ALGOL; %AS 

GO EXIT; 

TY15:: PHILECNOT 33 «- IOT; PHILECNOT 43 «- NUMDIM; 

TY16J5 TY17: TY18S 

e <- m or (*(p(.numdim)+size)),[18»153; 

if size = then comment fish out old sizes to use; 

begin;stream(A«-o»s«-*e); 

BEGIN TALLY«-i; SI*SJ SI4-SI-16; SKIP 2 sb; 
IF SB THEN TALLY«-2; A«-TALLY; 

end stream; 

IF(SIZEs=P) THEN DIM2 S s (*E ) . 18 : 103 ELSE 

DlM2?=P(*E*P(DUP).[8U0 3,,DIMl,STD*0,CDC*LOO).t8Jl0 3; 
END ELSE BEGIN DIM2 * NUMDIM; 

IF NOT SIZE THEN DIM1 <« RfCSlZE; 

end; 

if type - 18 comment "ion" function; 

then if size or cdim1 neq dim2) then p<(-543* 26* com); 
pollshcsize*e*39*c0m,del*del); % return old array 

POLISHCMKS* E); IF NOT SIZE ThEN PCOIMDI 

P0LISHCDIM2, SIZE, 1* 0* RECuRSE)* 
ARRY <■ *E; DIM1 <- DlMl-i; 

if type '■* 17 then comment m con w function; 
begin if size then p(*e> 2> ccx» e* ♦) else 
for 1*1 step 1 until dim1 do 
pol1shccarryci33* dup* lod* 2* ccx, xch* * ) ; 

end; 

if type * 18 then comment "iqn" function again; 
for 1*1 step 1 until dim1 do 

PC*CARRYEI33* I* CDC* 1, xCH, Ol 

go to exit; 
ty1<5!8 % implemented for cobol 68 array declaration 
arry <- *[prtpointeru733; 

MtrARRY[033 INX NOT 13,C2*13 ** 1* % MARK 
FOR I * 1 STEP 1 UNTIL ARRYC03 DO 
BEGIN 

C * arrych; 

PCMKS, tPRTPOlNTERtC,CFF333' 

P(DUP*L0D*P(DUP).CFF3,P(XCH) f CCF3 )* 
IF C»C17ll] THEN PCXcH*DEL) ELSE P* 

c.[16j23»1*c,ccf3*recurse); 

end; 
segdicu03 ♦ *p(dup)-i; % delete temp ait 

pccprtpointerc1733 inx m, 3, com, del ) ; 



1 OR 2 DIM 
IT SAVE 



00418210 
00418220 

00418230 
00418300 
00418400 
00418500 
00418600 
00418700 
00418800 
00418900 
00419000 
00419100 
00419200 
00419300 
00419400 
00419500 
00419600 
00419700 
00419705 
00419710 
00419715 
00419720 
00419725 
00419730 
00419735 
00419740 
00419745 
00419750 
00419755 
00419760 
00419770 
00419780 
00419790 
00419800 
00419810 
00419820 
00419830 
00419840 
00419850 
00419860 
00419870 
00419880 
00419890 
00419900 
00420000 
00420100 
00420105 
00420110 
00420120 
00420130 
00420140 
00420150 
00420160 
00420170 
00420180 
00420185 
00420190 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0322*3 
032411 

0326*3 
0329»1 
0329*3 
0332*1 
0335*3 
0340*1 
034250 

034682 
0347*3 
0352*0 
0354*3 
035750 
0357*2 
035752 
0358*0 
03625Q 
036250 
0364 5 3 
036552 
036752 
0368*2 
0369*2 
036953 
037251 
037611 
037752 
037951 
037951 
037953 
038351 
0384*3 
0386*2 
0387*3 
0390*0 
0390*3 
0393*2 
0395*0 
0399*1 
0399*1 
0400*0 
0402*0 
0406*1 
0406*3 
0407*0 
0408*1 
0412*0 
0416*0 
0416*0 
0417*0 
0416*1 
0420*1 
0422*2 

0424*2 

0425*0 
0427*0 



« 



py f T J * 

END INTRINSIC 



INTRINSIC* 



00429900 T 0428*3 
00430000 T 0428'3 

SIZE" 0430 WORDS 



PROCEDURE FILEATTRIBUTES(TANK*ERRL*DUM1,VAL*NAM,INF0*TEN) * 



START OF REU 






• 
# 
• 



VALUE T 

integer 

REAL ER 
NAME TA 
ARRAY T 
BEG 
% T 
% A 
% 
* P 
% 

% T 
% T 



% S 

% 6 

% X 

% I 



% 



ANK*DUM 

VAL ' 
RL*DUM1 

NK ; 

ENC*1 ; 

IN 

HIS PRO 

L60L CO 

F THE V 

ARAMETE 

TO 
HE COMP 
HE FILE 
WITCH L 
ETFILAT 
N» AND 
TS CODE 
ILE ATT 
HE PROP 
AL IS W 
NO STAC 



1*VAL*NAM*INF0*ERRL. i 
*NAM*INFQ ; 



C HAN 
MPILE 
ARIOU 
R RES 
ADD A 
ILERC 

ATTR 
ABEL 
T* AN 
ITS C 

BELO 
RIBUT 

ER TY 
ITHIN 
KS TH 



DLES F 
R* PRO 
S KIND 
ERVED 

NEW A 
S), TH 
IBuTE, 
NUMBER 
D ATTA 
ODE BE 
w THE 
E CAFT 
PE AND 

THE P 
E FILE 



ILE ATTRJ 
CEDURE Fl 
S OF FILE 
FOR POSSI 
TTRIBUTE* 
EN* DECLA 
E.G.* AC 
* E.G.* T 
CH XVN ON 
LOW THE L 
LAST XVN- 
ER MUCH C 

IN THE P 

ROPER BOu 

ATTRIBUT 



8UTES 
LEATT 

ATTR 
8LE F 

FIRS 
RE TW 
CESS* 
HE 4 
TO TH 
AST X 
TYPE 
HECKI 

ROPER 
NDS)* 
E. 



CFQR 
RIBUT 
IBUTE 
UTURE 
T MAK 
NEW 

AND 
IN MF 
F SWl 
N"TYP 

CODE. 
NG TO 

STAT 

AND 



MORE IN 
EHANDLER 

CALLS). 

USE. 
E THE AP 

LABELS* 
"N" IS T 
ID4 -- A 
TCH SETF 
E CODE* 
THE XN 

ASSURE 
US* AND 
THE XVN- 



FO* REFER TO THE 
* FOR A DESCRIPTION 
0UM1 IS A DUMMY 

PROPIATE CHANGES IN 
XN & XVN -- "X" IS 
HE CORRESPONDING 
ND ATTACH XN ONTO 
ILATT. THEN INSERT 
AND INSERT XVN* AND 
-TYPE CODE SETS THE 
THAT THE FILE IS OF 
THAT THE VALUE OF 
TYPE CODE RETRIEVES 



ARRAY FlBs + lC*]*FPB?=3t*] ; 

REAL F I B5* l 7* TYPE»9»FI*ERRL* SELECT* 14, INTRINSIC»5* 

0PEN*FIB+1* 

N0TCL0SREL*0PEN+1* 

N0TDISK=N0TCL0SREL+1* 

RTNVAL-N0TDISK+1* 

TEMPbRtNvAL + J,* 

PMET*TEMP+1* 

FPB3bDuM1*VAlSIGN=FIB* 

MFIDXc0PEN*FlDXsN0TCL0SREL*REELX=N0TDISK*DATEX=FPB3* 

CYCLEX=FI85*TYPEX=TYPE * 

LABEL QUIT*EXIT*SETUSE*VALER'T0IT*BIG*CHK1*CHK2*CHK3L*CHK3T*MYUSERR* 
OPENERR*CL0SRELERR 
*ACCESSO»ACCESSVO 
,MYUSE1* M YUSEV1 
*SAVE2*SAVEV2 
*QTHERUSE3*0THERUSEV3 
*MFID4*MFI0V4 
*FID5*FI0V5 
*REEL6'REELV6 
*DATE7*DATEV7 
,CYCLE8*CYCLEV8 
*TYPE9*TYPEV9 
,AREAS10*AREASV10 
,AREASIZE11*AREASIZEV11 



004 
SEGMENT) 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 
0@4 
004 
004 
004 
004 
004 
004 
004 
004 
004 
004 



30050 
DISK 
30100 
30150 
30200 
30250 
30300 
30350 
30400 
30450 
30500 
30525 
30550 
30600 
30650 
30675 
30700 
30750 
30800 
30850 
30900 
30950 
31000 
31050 
31100 
31110 
31111 
31112 
31113 
31114 
31115 
31116 
31135 
31140 
31155 
31175 
31200 
31225 
31250 
31260 
31270 
31280 
31290 
31300 
31310 
31320 
31330 
31340 
31350 
31360 



T 0000 

ADDRESS 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000 
0000 
0000 
0000 
OOOQ 
0000 
0000 

oooo 

0000 
0000 
0000 
0000 
0000 
0000 

oooo 

0000 

oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 

oooo 

oooo 

oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 



$0 

- m 

:o 
so 

«0 
»0 
JO 
*0 
1-0 
*0 
«0 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 

to 

JO 
SO 
JO 
JO 
JO 
JO 
SO 

so 

JO 
JO 
JO 
JO 
so 

JO 

so 

JO 
JO 
JO 
JO 

so 

so 

SO 
SO 
SO 
SO 

so 



• 



00084 



# 

# 



> %%%% ADD 
%%%% AND 



*EUNUM12#EUNUMV12 % Eu NUMBER FOR DISK 
>DSKSPEED13,DSKSPEEDV13 % FAST/SLOW OISK (1«FAST) 
#TIMELIMITH,TIMELIMITV14 % WaIT TIME FOR LOCKED ADDRESS CRLL) 
*IOSTATUS15,IOSTATUSV15 % LaST 10 RESULT STATUS (RLL) 
»SENSITIVE14»SENSITIVEV14 % SENSITIVE 
""'"" NEW ATTRIBUTE LABELS ON A NEW LINE ABOVE **************** 
BE SURE TO POST-FIX THE SWITCH NUMBER FOR DOCUMENTATION. 






SWITCH SETFILATT !» 

ACCESSO 
'MYUSE1 
#SAVE2 
»0THERUSE3 
>MFID4 
»FID5 
*REEL6 
#DATE7 
»CVCLE8 
,TYpE9 
'AREASIO 
#AREASIZEU 
#EUNuMl2 
*DSKSPEEDt3 
*TIMELIMIT14 
, I0STATUS15 

»SENSITIVElft 
; %%%% ATTACH THE NEW XN-TYPE ATTRIBUTE LABEL ONTO SWITCH ABOVE **** 



SWITCH GETFILATT 



%«X% ATTACH THE 



DEFINE 



CANTUSE 

10 

SERIAL 

RANDOM 

UPDATE 

PROTECT 

DISK 



ACCESSVO 
^MYUSEVI 
>SAVEV2 
,0THERU5EV3 
|MFIDV4 
»FI0V5 
*REELV6 
*DATEV7 
'CYCLEV8 
>TYPEV9 
*AREASV10 
*AREASIZEVll 
^EUNUMV12 
*DSKSPEE0V13 
*TIMELIMITV14 
*I0STATUSV15 
»SENSITIVEV14 
NEW XVN-TYPE ATTRIBUTE LABEL ONTO SWITCH ABOVE *** 

#> 

3 *» 

#* 

1 *> 

2 »> 

3 *» 



■ (NOT NOTDISK) t, 

P(HEADERl»l4# 



HEADERCHEA0ER1] * 
ERM(ERM13 s BEGIN 



FIB#LOD>INX>LOD>INX>LOD> *, 



00431370 
00431380 
00431390 
00431400 
00431410 
00431490 
00431495 
00431500 
00431550 
00431551 
00431552 
00431553 
00431554 
00431555 
00431556 
00431557 
00*31558 
00431559 
00431560 
00431561 
00431562 
00431563 
00431564 
00431565 
00431566 
00431567 
00431840 
00431850 

00431900 
00431901 
00431902 
00431903 
00431904 
00431905 
00431906 
00431907 
00431908 
00431909 
00431910 
00431911 
00431912 
00431913 
00431914 
00431915 
00431916 
00431917 
00432109 
00432200 
00432250 
00432259 
00432262 
00432265 

00432268 
00432269 
00432271 
00432274 
00432276 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 



0000»0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

oooo*o 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000 10 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 






• 



• 
• 



IN'ITERR? STREAMED' DS*13LIT ERMi; GO QUIT i 
END *t 

CHKOPEN ■ BEGIN IF OPEN THEN GO OPENERR ENO ## 
CHKCLOSREL ■ BEGIN IF NOTCLOSREL THEN GO CLOSRELERR END *» 
CHKMYUSE * BEGIN IF F I B5 , C 1 1 : 23*0 THEN GO MYySERR END #» 
p * POLISH #; 

SUBROUTINE INITERR ; 
BEGIN 

PMET + Pi FOR TEMP*P STEP -1 UNTIL 1 DO PCOJ P(PMET) ; 
PC1ANKCN0T 43); TANKfNGT 43*0; PC MKS* 9* INTR INSjC* DEL ) i 

TEN*0; TEN*P(CTENC.13]#CFX#SFB)UOC8I38U03 > 
STREAMCTEMP*NAM*A«-CFPBtFPB3-3 3]'N*NAM,[6l6]'TEN) i 

regin ds«-5lit"»fae#"j sua ; 
2(si*si + i; a*si1 tally*0* 7c if sc*" m then 
jump out? si*si41j tally*tally+1); s»aj a*tally ; 

d»di-i; ds*lit m ,« ; 



qs<-a chr; ds«-odec; ds«-lit*v*>; 
si*loc temp; si*si+2; ds*n chr; 
DI«-0I + 13; ds«-2lit m i*« ; 
END STREAM ; 

fi*p ; 
end of 



DS«-2LlT"# «; TEMP«-DI 



INITERR 



REAL 



; 



SUBROUTINE 0CTT0DEC 

BEGIN 

STREAM(Q«-0$VAL^ BEGIN 

OCTTODEOP ; 

END OF OCTTODEC ; 



SI«-LQC vAl; DI«-LOC q; D5«-8DEC end ; 



real subroutine oectooct ; 
begin pmet«-p(xch) ; 
streamcq«-ojpmet); begin si*loc pmet; di*loc q* ds*soct end ; 

DECTOOCT«.P ; 

end of dectqoct ; 

subroutine initialize ; 

begin % initializes a few useful variables* 
notdisk«-notc(notoisk«-ctype*fpbcfpb3*fib[«].c13«ll3 + 33 and 63) 
and 31)«10 or nqtdisk*12 or n0tdisk=13 or 

N0TDISK=26) ; 
NOTCLOSREL*NOTC0PEN*(FlB5<.FIBt5]),C«il23) ; 
0PEN«-0PEN = ; 
END OF INITIALIZE ; 

SUBROUTINE SCATTERFPB ; 

STREAM(F«-CFPBCFPB3-33 3#0«-CDATEx]*C«-[CYCLEX3*M*CMFlDX3) ; 
BEGIN 

$i«-f; 2(ds«-lit»0"; si+si+i; os«-7chr); dsooct ; 
oi*oj ds«-50ct; di*c; ds*20ct ; 
end of scatterfpb / 

%%%%,%%%%%%%%%%%%%%%%%%% % %%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%% %%%%%% 

%%% 

%%% ******* FIRST EXECUTABLE CODE ******** 

%%% 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%Tl>%%%%%%%%^%%%% 



00432277 


T 


ooooso 


00432278 


T 


0000*0 


00432280 


T 


0000*0 


00432285 


T 


0000*0 


00432290 


T 


0000*0 


00432475 


T 


0000*0 


00432480 


T 


0000*0 


00432500 


T 


0000*0 


00432550 


T 


000i*0 


00432560 


T 


OOOlJO 


00432600 


T 


0006*0 


00432700 


T 


0010*0 


00432750 


T 


0013*1 


00432800 


T 


0016*2 


00432850 


T 


0017*3 


00432900 


T 


0019*2 


00432950 


T 


0021*1 


00432975 


T 


0023*2 


00432980 


T 


0025*1 


00433100 


T 


0026*0 


00433150 


T 


0026*1 


00433200 


T 


0026*3 


00433220 


T 


0027*0 


00433230 


T 


0027*0 


00433240 


T 


0027*0 


00433250 


T 


0027*0 


00433260 


T 


0029*1 


00433270 


T 


0029*2 


00433275 


T 


0029*3 


00433280 


T 


0029*3 


00433290 


T 


0030*0 


00433295 


T 


0030*3 


00433300 


T 


0033*0 


00433310 


T 


0033*1 


00433325 


T 


0033*2 


00433650 


T 


0033*2 


00433660 


T 


0034*0 


00433670 


T 


0034*0 


00433675 


T 


0036*2 


00433677 


T 


0040*3 


00433680 


T 


0042*2 


00433685 


T 


0045*1 


00433690 


T 


0046*2 


00433725 


T 


0046*3 


00433750 


T 


0046*3 


00433760 


T 


0047*0 


00433775 


T 


0049*1 


00433780 


T 


0049*1 


00433785 


T 


0051*1 


00433790 


T 


0052*1 


00435445 


T 


0052*3 


00435446 


T 


0052*3 


00435447 


T 


0052*3 


00435448 


T 


0052*3 


00435449 


T 


0052*3 


00435450 


T 


0052*3 


00435460 


T 


OQSg! 3 



# 
# 



• 

• 



• 



?,l T ^^ C ^J„ 2 L'S'^2^ ' O ' 05; TANKCNDT 43«-ERRL> INITIALIZE } 
IF CFI*INFO AND 255)>3 AND Fl<10 THEN SCATTERFPB ; 

IF NAM>0 THEN IF A BS ( V AL )>®7777777777777 THEN GO VALER ELSE VALVAL* 
IF lNF0.C39»n THEN IF INF0«-INF0„ C 38 * 1 3 THEN RTNVAL*VAL 

ELSE BEGIN TANK[NOT 43*-0; GO 6ETF I L ATT t F I ] END 
ELSE INFO«-FALSE > 
GO SETFILATTCFH ; 

MYUSERRl* ERMr'MYUSE-CANTUSE M ) ; 
CLOSRELERRJ5 ERM("NOT CLOSRELES") ; 

openerr:? initerr; streamcfd; DS<.13LIT M NDT RWND/CLSO« I 
QUTTJJ P(CTEN[O]],C33M53'34#C0M) ; 

ACCESSOs IF ((FUTYPE ANO 31)*12 AND VAL*SERIAL) 

OR CFIsio AND VALsRANDOM) OR CFI»13 AND VAL*UFDATE) 
$ SET OMIT ■ NOT SHAREDISK 

THEN GO EXIT; 

PCFP8CFP833,[FPBCFPB3]],FiBt4 3*CFIBt4n#FIBCl33,CriBtl3n* 
3) ; 

FP8[FPB3].U3i5J*Fl*IF VAL=0 THEN 12 ELSE IF VAL*1 THEN 10 

$ SET OMIT a NOT SHAREDISK 

S SET OMIT = SHAREDISK 

IF FI8U3. [27:33/3 THEN F IB U 3 . [27 J 33 *VAL ; 
FIB[13J.C39l5]*Fi; PCUPDATE); GO CHK3T ; 

* POP OMIT 

* SET OMIT = NOT SHAREDISK 



MYUSE1I 

SAVE2J 

0THERUSE31 
SETySEJ 



MFID4J 
FIDS : 

REEL6? 
DATE75 

CYCLE8? 

TYPE9J 



IF FIBS, tll:23=VAL THEN GO EXIT ; 

IF PCCFlBCl43]»L0D).tFF]»2 THEN P( MKS,"CHNGNG"# TANK*7, 

SELECT)) 

fibc5],ch»2]«.fi*val; tewp*-fib5,[9j23; pen; go setose; 

IF FIBU3.C30;183sPMET«-QCTTODEC THEN GO EXIT J 

PCFl8C43,CFl8[«n#l) *, 
FIB[43,[30J183«-PMET; P<999); GO CHK2 ; 

IF FIB5,C9;23=VAL THEN GO EXIT ; 

FI*FIB5,C11»23; FlB[53.r9»23«"TEMP*VAL; PCO) ) 

PMET<-P; PCFIB5*CFIBC5]]#1> ; 

IF DISK THEN IF HEADERU3 THEN CHKCLOSREL ELSE CHKOPEN ; 

FIBC53.C 1 3: 334-iF Fl*0 THEN 7 ELSE IF TEMPsO THEN 4 ELSE 

IF TEMPal THEN IF FI«1 THEN 3 ELSE 2 ELSE IF 

fi = 1 then i else ; 
pc 10 ji if not pmet then go chk2j go chk1 ; 

pc,mfidx*0#mfidx); go toit ; 

pc.fidx,0»fiox); go toit ; 

p(.reelx*val>999,reelx); go toit i 

pc.datex*val div 1000>99 or val mod 1 000>366> datex ) ; 

go toit ; 

pc.cyclex*val>99»cyclex); go toit j 

pc.typex»val>63 orcval and 3 1 ) = 3 orcval and 3l)>26# typex ) ; 



00435480 

00435550 

00435600 

00435750 

00435800 

00435825 

00435850 

00435855 

00435860 

00435870 

00435900 

00435980 

00436000 

00436025 

00436049 

00436075 

00436080 

00436085 

00436180 

00436184 

00436190 

00436194 

00436195 

00436200 

00436201 

00436209 

00436225 

00436250 

00436260 

00436270 

00436330 

00436350 

00436400 

00436410 

00436520 

00436550 

00436600 

00436660 

00436670 

00436675 

00436680 

00436685 

00436690 

00436710 

00436725 

00436750 

00436775 

00436800 

00436825 

00436850 

00436875 

00436900 

00436905 

00436925 

00436950 

00436975 

00437010 



T 


0052*3 


T 


0059*0 


T 


0063*0 


T 


0065*3 


T 


0069*2 


T 


0083*1 


T 


0084*2 


T 


0094«0 


T 


0098*2 


T 


0103*2 


T 


0108*0 


T 


0109*2 


T 


0109*2 


T 


01il»3 


T 


0115*2 


T 


0115*2 


T 


0117*0 


T 


0120*0 


T 


0120*1 


T 


0124*0 


T 


0120*0 


T 


0127*1 


T 


0127*1 


T 


0131*3 


T 


0135*0 


T 


0135*0 


T 


0135*0 


T 


0135*0 


T 


0136*3 


T 


0140*0 


T 


0140*1 


T 


0145*1 


T 


0147*0 


T 


0150*1 


T 


0151*2 


T 


01541-3 


T 


0154*3 


T 


0156*2 


T 


016l?0 


T 


0162*2 


T 


0168*2 


T 


0173*2 


T 


0177*2 


T 


0181*0 


T 


0182*2 


T 


0182*2 


T 


0183*3 


T 


0183*3 


T 


0185*0 


T 


0185*0 


T 


0186*3 


T 


0186*3 


T 


0190*0 


T 


0190*2 


T 


019QJ2 


T 


0192*1 


T 


019211 



i 

i 



m 



€ 



TCIT8 






AREASlQ: 



AREASIZEH 



CHK3L5 
CHK3T: 

CHK28 : 

CHK18 J 

VALERJ 



EUNUM12J 



DSKSPEED13! 



if p=val then begin p(del,del)j go exit end } 

initialize; pcoj; chkmyuSe; chkopen ; 

if fibu3, £24823*1 or f ib [ 43 , c8 8 43 *2 then chkclosrel 

else if fi*4 qr fi*9 then erm("cls*»not altr") ; 

if pcxch) or val.c1«53^0 then go valerj scatterfp8 ; 

pcdel>val>xch,«-,mks,tank,mfidx»fidx>reelx>datex>cyclex* 

TYPEX, 11 j. INTRINSIC) ; 
GO EXIT ; 

IF NOTDISK OR V AL = F IB C 8 3 , [ 20 J 5 ] THEN GO EXIT ; 

PCFI8[8],CFIBt8]],l) i 
FIB[83.C2055]<-VAL^ P(20); GO CHK3L i 

IF NOTDISK OR V AL*FIBC 83 . C 25 8 233 THEN 60 EXIT ; 
P(FIBC83*[FI8[8]3*1) } 
FIBt83.C25l233*VAU; P(BlG) ; 
PMET+P' CHKCLOSREL; P(PMET); GO CHK2 ; 
PMET+P; CHKOPEN^ P(PMET) ; 
PMET«-P> CHKMYUSE/ P(PMET> J 
IF P>VAl AND NOT VAL*C1 * 1 3 THEN GO EXIT i 
N0TDI3K«.ABSCVAL5 i 

OPEN^Oi WHILE TENtOPEN*OPEN+13SNQTDISK DO; INITERR ; 
STREAM(N*-OPEN^V«-NOTDISK*T*-TYPE*L«-VALSIGN*-VAL.tlSllj'Q*NAM<0 
fR*(0PEN + VALSIGN)>8'E«-l + (TYPE>9)»W«-VAL»FI) > 

BEGIN 

DUOI-2; DS«-2LIT":=» ; 

QCSI«-L0C Wj DS*BCHR;- JUMP OUT TO J); L< DS*L IT"-" ) ; 

P(ds«-7lit"*"> jump out to j); sj>loc v; ds«-n dec ; 
j: suLOc t; ds<-3lit»,ts m ; ds«-e dec; ds*2lit"««. m ; 

END OF STREAM ; 
GO QUIT ; 

IF NOTDISK OR OPEN OR FP8 CFPB3 3 , C 18 85 3*VAL+1 THEN GO EXIT; 
P(FPBtFPB33,tFPBtFPB3]3*l); % STORE FOR RECOVERY 
FPB[FPB33,El8?53J*VAL+i; % EU NQ. + l 
IF VAL=C-1) THEN VAL-' = l; P(19); GO TO CHK2; 

IF NOTDISK OR OPEN OR FPB[FPB3 3 . [ 16 82 3 =VAL THEN GO EXIT; 
PCFPB[FP83J,CFPBCFPB3]J,1)J % STORE VALUES FOR RECOVERY 
FP8[FPB33,C1682]8=VAL; % 1=FAST, 2*SL0W 
P(2); GO CHK2; 



TIMELIMIT14S 
t SET OMIT - NOT SHAREDISK 

IOSTATUS158 GO EXIT; 



SENSITIVE14 



B I G : 8 : 



IF NOTDISK OR FPBCFPB33 , C 15 8 1 3=V AL THEN GO EXIT* 
P(FPBCFP833#CFPBCFPB333*1); % STORE FOR RECOVERY 
FPBCFP83 3.C15 8 13 8=VAL; %SENSITIVE*1 
PCI); GO CHKi; 

937777777 ; 



%%%% ,%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 

%%%%% INSERT NEW XN-TYPE ATTRIBUTE CODE ON NEW LINES ABOVE HERE %%%% 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 



00437030 
00437040 
00437070 
00437090 
00437105 
00437110 
00437125 
00437130 
00437150 
00437200 
00437210 
00437240 
00437275 
00437300 
00437310 
00437340 
00437350 
00437360 
00437370 
00437380 
00437400 
00437410 
00437440 
00437450 
00437470 
00437480 
00437490 

00437500 
00437510 
00437520 
00437530 
00437550 
00437560 
00437570 
00437580 
00437590 
00437600 
00437610 
00437620 
00437630 
00437640 
00437650 
00437700 
00437710 
00437760 
00437770 
00437780 
00437800 
00437810 
00437820 
00437830 
00440000 
00449999 
00450000 
00450050 
O0450j,00 
00450150 



019682 
0198?2 
020380 

020783 
0215»2 
021980 
022183 
022282 
022380 
022380 
0225*3 
022780 
023081 
023081 
023380 
023481 

0237*0 
023981 

024183 
0244«2 
0247*2 
0249»0 
025480 
025652 
026081 
026Q81 
026180 

026480 
026781 
0269 8 1 
0269*2 
0270*0 
027080 
027380 
027580 
027880 

028180 
028i 10 
028481 
0285*2 
0288»0 
0288»3 
028883 
028883 
028883 
028883 
02898! 
028981 
0292»0 
0293*1 
029583 
029682 
0298»0 
029880 
029880 
0298»0 
029880 



# 



ACCESSVO* PCIF (Fl*TYPE AND 3l)«10 THEN 1 ELSE IF FI-J3 THEN 2 
$ SET OMIT s NOT SHAREDISK 
ELSE OjRTN); 



• 



MYUSEVU 

SAVEV2? 

OTHERUSEV3: 

MFIDV4* 

FIOV5J 

REEIV6J 

0ATEV7J 

CYCLEV8J 

TYPEV9J 



p(FIB5 t [ll»2],RTN) * 
P(FIBC4], C30?183,DECTQ0CT,RTN) ; 
P(FI85«C9J2]*RTN) / 
P(MFIDX#RTN) ; 

p(fiox*rtn) ; 

pcReelx,rtn) ; 

P(DATEX,RTN) i 

pccyclEx^rtn) ; 
pctypex,rtn) j 



AREASVIOI IF FI8[83. [20*28] m AND FlBt«3.t8U] * 4 AND OPEN 
THEN P(HEADERC9J.t43*51*RTN) 
ELSE PCFI8C83,[20S5],RTN); 

AREASIZEVU J 

IF FIBC83.C20J28] = AND FIB[4].[8*4] ■ 4 AND OPEN 

THEN P(HEADERC83.t25«233#RTN) 

else p(fibc8].[25:233#rtn>; 

eunumv12: p(fpb[fpb3 3,[18j5 3-1*rtn); 

dskspeedv13! p((if (temp ! «fpb t fpb3 3 . [ 16 * 2] )• 1 then 1 else 

if temp*2 then 2 else 0>,rtn); 
timelimitv14! 
$ set omit = not sharedisk 
pco)« p'crtnjj 
i0statusv15! 

$ set omit ■ not sharedisk 
pcoj; pcrtnj* 
sens it i vev 14 * pcfpb [fpb3 3 . [ 15 ! 1 3 > rtn ) ; 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 

%%%% INSERT NEW XVN-TYPE ATTRIBUTE CODE ON NEW LINES ABOVE HERE %%%% 

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 

EXIT: TANKCNOT 43>0* IF INFO THEN P( RTNVAL'RTN 3 I 
END OF FILEATTRIBUTES j 



00450200 
00450250 
00450254 
00450260 
00450300 
00450400 

00450450 
00450500 

00450550 
00450600 
00450625 
00450650 
00450675 
00450700 
00450725 
00450750 
00450775 
00450800 
00450825 
00450850 
00450875 
00450900 
00450925 
00450950 
00450951 
00450952 
00450975 
00451000 
00451001 
00451002 
00451003 
00451025 
00451050 
00451055 
00451075 
00451099 
00451150 
00451175 
00451199 
00451250 
00451300 
00469999 
00470000 
00470050 
00470100 
00470150 
00470200 
00470250 
00470350 



T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
C 
C 
T 
P 
C 
C 

c 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0298*0 
0298*0 
030l?3 
030i:3 

0303*2 
0303*2 

0304*2 
030fl*2 

0307*1 
0307*1 
0308*1 
0308*1 
0308*3 
0308*3 
0309* 1 
0309*1 
0309*3 
0309*3 
0310*1 
0310*1 
0310*3 
0310*3 
0311*1 
0311*1 
0314*2 
0318*1 
0320*0 
0320*0 
0320*0 
0323*1 
0327*0 
0328*3 
0330*2 
0333*3 
0336*1 
0336*1 
0336*1 
0336*3 
0336*3 
0336*3 
0337*1 
0338*2 
0338*2 
0338*2 
0338*2 
0338*2 
0338*2 
0338*2 
0341*2 



SIZE* 0342 WORDS 



PROCEDURE ALGOLREAOCTEN* FILX, DKADD* ACT, FI* AEXP» 
ARRY* £OFL> PARL* DKADR> CODE* TANK); 



XWF 00500000 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS * 00096 

XWF 00500100 T 0000*0 



• 






VALUE FI# DKAOR# TANK, COOEf 
ARRAY ARRYC*3, TENC*3 J 
INTEGER ACT, FI» AEXPj 

real okadd, parl, eofl* code 
name filx, Tank; 
begin real rcws+0,blkcntl=5, select*14 

name mem=2;% 

array fp8=3c*3'% 
real algdlread=13; 
array tink*tank[*]; 

INTEGER RSlZE=Fi; 
DEFINE FNUM * F IB[ 4 3 , [ 1 3 5 1 1 ] #; 
DEFINE lQD=C*TAN|K)i!f;% 

$ set omit = not sharedisk 

label dcwdc2, 

label dcni»dcn2,spin; 

label cr1*m't1«cu0se0#dk1#sp.1#pr 

switch swl* cr1>err>mt1»cl0sed,d 

ERR»DCN1) 
LABEL CR2>MT2f DK2fSP2,PR2J% 
SWITCH SW2* CR2'ERR'MT2#ERR'DK2# 

ERR,DCN2> 
LABEL SW,PBIT,DS,FI67,DSPBIT,PA 
LABEL EMPTY, FULLj»5EMPTY,SFULL; 

real unitype'revf address'blkooe 

$ set omit * not sharedlsk 
Label dks#okr*okri»dkuj 
switch asw«-dks»dkr*dku»closed; 

$ set omit 4 not(timesharing) 
subroutine wait; polishc tank, 0200000 

* POP OMIT 

$ SET OMIT * TIMESHARING 
LABEL RU#RA»RC!» 
SWITCH RTYPE*RUf RAfERRf RC;% 
LABEL OKSR'DKRRjDKUR;* 
SWITCH ASWR«-DKSR,DKRR,OKUR/« 
ARRAY FIBE*3*HEADERt*])% 
$ SET OMIT = NOT SHAREDISK 
INTEGER in 

REAL SUBROUTINE DISK ADDRESS** 
BEGIN IF DKAOR^O THEN* 
BEGIN ADDRESS*-(DKADR DIV HEADER 
IF (I«-ADDRESS DIV H£ADER[ 
IF HEADERtI3=0 THEN P(0) 
BEGIN ADDRESS*HEADERU3 + I 
STREAM(D«-CADDRESS]) 

pen;* 

END END ELSE P(0)JX 
DISKADDRESS*-P;% 
END DlSKADDRESS;% 
$ SET OMIT = NOT SHAREDISK 
IF TINK=0 THEN 
BEGIN FIB «• FILXCNOT 23 
FILXCNOT 43 * EOFL 
IF NOT FIBC53.C12:13 TH 
IF FIBC53.C43*23*( 
P(MKS, DKADD, (A 



ACT' AEXP; 
, DKADRJ 



SWF 
%WF 

%WF 
%WF 
%WF 



%WF 
S8WF 
SWF 



K1,SP1,ERR*ERR>£RR>PR1*DC1*CRJ.> 



SP2,ERRfERR>ERRfPR2fDC2fCR2f 
R,DSRTN,DSl9,RAlfEQF,Q28;% 



OOQO, 36, COM, DEL* DEL); 



t0]tC30ll2])xHEA0ERt03.C42»6]l% 

13+10)>30 THEN PCO) ELSE 

ELSE 

♦ADDRESS MOD HEADERCl3;% 

; BEGIN SI*D; DS«-8 DEC ZHDi% 



%WF 
; %WF 

; filxcnot 33 <• parl; *WF 

EN P(MK$, M READNG"#FILX, 7, SELECT) ; 
(AcT<0)+2) THEN %WF 

CT<0)+2, FILXf It SELECT); %WF 



00500200 
00500300 
OO5OO4OO 
00500500 
00500600 
00500700 
00500800 
00500900 
00501000 
0050H00 
00501200 
00501250 
00501300 
00501309 
00501400 
00501410 
00501500 
00501600 
00501610 
00501700 
00501800 
00501810 
00501900 
00501950 
00502000 
00502049 
00502100 
00502200 
00502250 
00502252 

00502253 
00502299 
00502400 
00502500 
00502600 
00502700 
00502800 
00502809 
00502900 
00503000 
00503100 
00503200 
00503300 
00503400 
00503500 
00503600 
00503700 
00503800 
00503900 
00504000 
00504009 
00504200 
00504300 
00504400 
00504450 
00504500 
00504600 



T 
T 

T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



oooo«o 
oooo'o 
0000*0 
0000*0 

000080 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0004*0 
0004*0 

0004*0 

0004*0 
0004*0 
0004*0 
0004*0 
0004*0 
0004*0 
0004*0 
0004*0 
0004*3 
0008*2 
0011*3 
0014*0 
0017*1 
0018*3 
0019*0 

0019*3 
0020*0 
0020*1 
0020*1 
0023*3 
0026*0 
0029*2 
0032*2 
0035*0 



• 



d 



RSIZE * p; 



RSlZE*P(MKS#CABSCACT>««3)*DKA0D#l,FILX*ALG0LREA0> J 
IF ARRY/O THEN 

BEGIN IF ARRY»[8*103>P(DUP* AEXP) 
THEN PCDEL* AEXP3; 
IF PCDUP)>RSIZE THEN P(DEL) ELSE 
STREAMCP4 «• *FILX* P3 «• RSIZE* 

92 *■ P(DUP), [36*63* Pi «■ EARRYCO]]); 
BEGIN SI «■ P4; DS «■ P3 WDS; 

P2CDS * 32 WDS; DS * 32 WdS)J 

end; 
end; 

if abscact)£2 then% 
p(mks* dkadd* q* fllx* algolread); 
43 <• filxcnot 3] * q; 




• 






FlB*-TANK[ 

SWJ UNITYPE*F 

$' SET QMIT = T 

IF DKADR, 

BEGIN 

$ SET OMIT - N 

DKAO 

end; 

IF CODE T 
MT1IX 
CR1 IS 

PR1S IF IOD.tl 
PBIT:. BEGIN IF 
BEG 



FlLXCNQT 
P<XIT)J 

no; 

NOT 2U% 
IBC43.t8U3; 
IMESHARING 
[4*13 THEN 

OT SHAREDISK 
R.C3s2]«-0; 



XWF 
XWF 
XwF 
XWF 
XWF 
XWF 
XWF 

XWF 
XWF 

XWF 

XWF 
XWF 
XWF 
XWF 



REV-FlBC5 3.f44:l3; BLK0DE«-FI8[5 3 , [46 J 2 3 ; X 



/ 




7 ./ 



CLOSED* 



/ 

( 

^EN 



HE 

I 

10 
IN 




/ 



END 

IF 

BEG 




END 
EOF! IF CODE « : 



N GO TO SWUUNITYPE3; GO TO SW2CUNI TYPE 3 ; % 

13 T H E N X u4/» curvet. H^n^P^i, scti<&H<& r^ 6ir ^ 
D C 2 J 1 3 THE NX 
IF FIBU7330 THEN FI BC 173«"*< C I F REV THEN 1 ELSE NOT 03 

INX FLAGCFIBU63))!* 
PCCIF BLKODE THEN IOD. [8*103 ELSE F IB C 173 ) * RTN 3 ; X 
}% 

IOD. C25I13 THENX 
IN 

FIBC133,[27!13*1; 

IF (REV><FPB[FNUM+33 AnD 31 ) >/ JO AND REV/12 

AND REV/13 AND REV/26 THEN F IB [5 3 , [45 * 13 *0 ELSE 

Fl8t53.C«5ll3*PCTANKCNOT 33*DUP)/0 AND P(XCH)*15; 

P(TANK*0*H*COM*DEpDEL) I 

IF NOT FIBCSJt C45I/13 THEN GO SW ; 

PCTANKtNQT 33); TANK[NOT 33*TANK£NOT 43*0 ; 

P(MKS*9*BLKCNTRL,DEL) jX TAKE PARITY ACTION LBL BRNCH, 

code*i; GO TO ds; 

0»[27513 THENX 
IF UNITYPE=2 THENX 
IF FIBC43,t2H3 THENX 

P(MKS*1*0*(N0T 2)JNX TANK*4*SELECT) ELSE* 
PC TANK* 1 1,11* COM* DEL* DEL )**X 
IF MEMCTANKENOT 13 INx 43. [42:63=1 THENX 
BEGIN UNITYPE«-FIB[133,[28U03;X 

P(MKS*6,0*(N0T 2)INX TANK, 4* SELECT >*X 

FIB[133,[28U0 3«-UNlTYPE + i;x 

go to closed;x 

ENOU 
THEN PC1*SSN,RTN); CODE * Z't 



00504700 
00504800 
00504900 
00505000 
00505100 
00505200 
00505300 
00505400 
00505500 
00505600 
00505700 
00505800 
00505900 
00506000 
00506100 
00506200 
00506300 
00506400 
00506440 
00506460 
00506465 
00506469 
00506475 
00506480 
00506500 
00506600 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



00506700 T 
00506800 T 
00506900 T 
00507000 T 
00507100 T 
00507200 T 
00507300 T 
00507400 T 
00507410 T 
00507420 T 
00507430 T 
00507440 T 
00507450 T 

00507510 T 
00507515 T 
00507520 T 
00507525 T 
00507530 T 
00507535 T 
00507600 T 
00507700 T 
00507800 T 
00507900 T 

00508000 T 
00508100 T 
00508200 T 
00508300 T 
00508400 T 
00508500 T 
00508600 T 
00508700 T 



\ 

V 



0038*0 
0040*3 
0041*3 
0043*3 
0045*0 
0048*2 
0049*2 
0051*0 

005j*3 
0053*0 
0053*1 
0053*1 
0054*1 
0056*0 
0059*1 
0059*2 
0059*2 
0061*1 
0065*3 
0065*3 
0066*2 
0067*0 
0067*0 

0068* 3 
0068* 3 
0085*2 
0085*2 
0085*2 
0086*2 
0088*0 
0092*1 
0094*1 
0097*1 
0097*1 
0098*1 
0098*3 
0101*1 
0104*3 
011012 
QU6*1 
0117*3 
0119*1 
0123*3 

0124*3 
0126*0 
0126*0 
0127*0 
0128*1 
0129*3 
0132*2 
0134*2 
0138*0 
0140*0 
0142*1 

0145*1 
0145*3 
0145*3 






m 

m 



# 



\ 




^ 






END ELSE(>A^ TANKC03<-I0D OR MEM;% 

IF CODE *-y THEN BEGIN P( 0, [TANK [NOT 233 * 19, 1 7* COM ) ; 

P(0*RTN)| e^D^ 

PCTANKCN0T(CODE + ?)3 )i 

TANKCNOT 43<-TANK[NOT 33*0; 

PCMKS#9#BLKCNTt); 
OS! P(TANK#CODE»U,COM);X 
-- ENDJ% 

p(tank); wait/ go to pbitjx 
code«-3; go ds;x 

HEAOER**tFlBCHn; GO TO ASW I FIB C43 . 1 27 J 3 3 3 } % 
HEADER**CFIBCH33; GO TO ASWR[F IB [ 4 3 , [27 S 3 3 3 ',% 



ERR! 
OKI ! 
DK2: 
CR?s 

MTt? 
PR2? 
Rljt 



60 TO RTYPErBLKQDE3;% 

TANKC03«-FLAG(FIBC163); PC FLAG (FIB [ 19 J ), TANK *PRL» DEL 3 '>% 

BuKODE*-FIBCl93,t33!153-FIBCl63,C33*153;% 

FIBC163 . C 33 1 153«- CODE«-(*((IF REV THEN 2 ELSE NOT 1) INXX 

FLAG(FIB[163 )}}.C18ilS3;X 
riBC193»t33ll5]*CQOE+BLKODE;X 
FlB[63«*(REV«-l&REVEU47ll3)+FIBC63;X 

fibc7]*fibC73 + rev; fibei?3«-o; PCXIT3;% 

RA! IF (FIBCl73*FIB[l7]-CQDE*FlBCl8],r33»153)<CODE THEN GO TO RUJX 
RAH TaNK[0]«-(IF REV THEN NOT CODE INX 1 ELSE CODE) INX I00i% 

GO TO FIB7JX 
RCJ IF (FI8C173<-FIB[173-C0DE«-I0D.[8:103 + 1)<1 THEN GO TO RU;% 

if rev then* 
begin;stream(S«-iod*d«-ccode3);x 

begin si + s; si«-si-8; ds«-4 oct end;% 

tankc03«-(not(cooe*code div 8 -1) inx iod )4c0dec8 * 38 * 10 3 }% 
end elsex 

BEGIN;STREAM(S*CTANKC03*C00E INX I0D)*DHC0DE3)J% 

begin si*s; sj>sim; os*4 Oct endjx 

TANKt03«-l0D&CC0DE DIV 6 - 1 ) [8 t 38 * 103 *% 

end;% 

FlB[73«-UREVCllfl7in+FlB[7j;j! 
TANKC03*I0D&(N0T P(DUP))t2*28tn;j{ 

pcxnm 



FIB7S 

D28S 

SP2J 

DKUSX 

DKS: 

DS19? 

DSPBIT* 



•NO ADDRESS SPECIFlEDi% 



C185153JX 



IF DKADRsO THEN % NORMAL SEQUENTIAL READ' 
IF IOD. C 19 s 1 3 THEN% 
IF IOD.C2U3 THEN% 
IF FIB[73>HEADER[73 THEN% 

BEGIN TANK[03«-IQD&0[2 82*1 3&1 [27*47 *n;X 
GO TO EOFJ% 

END ELSE* 

OSRTN: BEGIN IF FIBC 173 = THEN FIB r 173 *FI8 [ 183 . 

PCFIBC183, [33*153, RTN>;% 

END EL.SE* 

IF IOD.G25J13 THEN GO TO CLOSED ElSE% 

IF I0D.C27J13 THEN GO TO EOF ELSE GO TO PAR ELSE* 

BEGIN P(TANK); WAIT' GO TO DSPBIT END;X 

X READ OR SEEK ON A SERIAL FILE WITH ADDRESS SPECIFIED** 

P(MKS,A8S(DK ADR)- \>\* TANK, 1* SELECT )i% 

IF DKADR<0 THEN GO TO DSRTNJ GO Tq DS19JX 

DKSR: If DKADR>0 THEN GO TO D28 ELSE IF DKADR=0 THEN% 

BEGIN IF (FIBU73«-FlBC173-CODE«-FlBtl83,[33J153)^CODE THEN GO 



RAi; 



0050880Q 

00508900 

00509000 

00509400 

00509500 

00509600 

00509700 

00509800 

00509900 

00510000 

00510100 

00510200 

00510300 

00510400 

00510500 

00510600 

00510700 

00510800 

00510900 

00511000 

00511100 

00511200 

00511300 

00511400 

00511500 

00511600 

00511700 

00511800 

00511900 

00512000 

00512100 

00512200 

005t2300 

00512400 

00512500 

00512600 

00512700 

00512800 

00512900 

00513000 

005131OO 

00513200 

00513300 

00513400 

00513500 

00513600 

00513700 

00513800 

00513900 

00514000 

00514100 

00514200 

00514300 

00514400 

00114500 

00514600 

00514700 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0148*2 

0150*2 

0153*3 

0154*1 

0156*0 

0159*1 

0160*0 

0161*0 

0161*0 

0162*2 

0163*3 

0168*3 

0173*1 

0173*1 

0173*1 

0176*1 

0179*1 

0182*0 

0185*0 

0188*1 

0190*3 

0194*1 

0197*3 

0202*0 

0205*3 

0206*1 

0211*0 

0211*1 

0213*0 

0214*0 

0218*1 

0218*1 

0221*0 

0222*0 

0225*0 

0225*0 

0228*0 

0230*1 

0230*2 

0230*2 

023l*l 

0232*3 

0234*1 

0236*0 

0239*2 

0240*0 

0240*0 

0244*1 

0245*2 

0245*2 
0247*0 

0249*3 
0252*2 
0252*2 

0254*3 
0256*2 
0258*2 



i 



# 



• 



F 1 8 C 6 ] <- C RE V* HRE V [1 » 47 U3 ) + F I B C 6 3 ; % 

FIBE173*G;% 
DKADR*FIB[73% 

+ FlBCl3]aiO:93xHEAOERE03 f [30 8 12 3xREVi% 

FIBE73«-FIBC73+REV;% 

IF DISKADDRESS THEN% 

BEGIN P(TANKE03*FLAGCFIBE16 3)>ADDRESS*XCH*O;% 

P(FLAG(FIBtl93)#TANK»PRL#0EL)IX 

END ELSE* 

BEGIN TANK [03«.FLAG<FIBC 16 3)42 [27 146 12 H0C2U7«im 

pcfibc133 . e 10193 > tank, 13, 11* com, del* del, del) ;x 

end;* 

plk00e«-fibc19 3.c33:15 3-fibc16 3.c33j153;% 

FIBtl6] t C33U53*COOE*MEMcP(DUP) INX NOT l3,tl8H5JIX 
FIB[19 3,[33*153*CODE+8LKODE;% 
ENOIX 
DKRRl P(XIT);X 
DKRJ 

* SET OMIT = NOT SHAREDISK 
DKRJ. I IF DKADR GEO THEN 

BEGIN IF DKADRso THEN DKADR*FIBC73 ELSE FIBE7 3*DKADR«-DKADR-1 ; % 
IF HEADERm^DKADR THEN* 
IF DISKADDRESS THEN% 

BEGIN C0DE*FIBC163,[33U5JJ UNITYPE«-FIB E 133 » C 10*93 ;% 

1 UNTIL UNITYPE DOX 



$ SET OMIT s 



FOR 1*0 STEP 

SHAREDISK 

BEGIN IF NOT 



IOD. C19H3 THEN BEGIN PCTANK)) WAIT END) 



POP 
SET 



OMIT 

OMIT 



9 NOT SHAREDISK 

if I0D.C27UJ then go to empty;* 

$ SET OMIT * SHAREDISK 

IF (MEMEC0DE3 EQV ADDRESS)«NOT THEN GO FULL; 



$ 
$ 



POP 
SET 



OMIT 
OMIT 



* NOT SHAREDISK 

TANKt0]*I0D4lC27U7liJ;% 
P (UNITYPE* TANK* l 3* ll'C0M,OEL*DEL» DEL ))X 
FlBtl63,C33U53*CODE«-MEM[CODE-23,[18 J 15 3;% 
FlB[193,E33«153*C0DE+i;* 
END) GO TO ERRU 



EMPTY* 
$ SET 



OMIT * NOT SHAREDISK 

FlBtl33*Ilb»93«-i; 
PCTANK[03*FLAG(FI8E163)*ADDRESS*XCH#*)jX 

P(FLAG(FIBE193)*TANK*PRL#DEL)*X 
FIBtl33.ElO«93*UNlTYPE; P(TaNK)J 
$ SET OMIT * NOT SHAREDISK 



FULL' 
$ SET OMIT 



$ SET OMIT 



WAIT) 
IF NOT 
BEGIN 

end; 

= NOT 



I0D.C2:i3 OR FIBE53.EH13 THEN 



SHAREDISK 
C00E*1) GO 

SHAREDISK 



TO PAR. 



IF BLKODE*0 THEN SFULL * P(F IfiC 183 . E 33 : 153 * RTN }) 
TANKE03*I0D&C(I*DKADR MOD HeADERC 03 , E 30 : 123 )% 

x(I*FlB[18].C33»15])+FlBCl93 t C33U5])t 33 1331153;% 
P(I#RTN)J* 



00514800 
00514900 
0§515000 
00515100 
00515200 
00515300 
00515400 
00515500 

00515600 
00515700 
00515800 
00515900 
00516000 
00516100 
00516200 
00516300 
00516400 
00516410 
00516419 
00516500 
00516600 
00516700 
00516800 
00516900 
00517000 
00517099 
06517100 
00517101 
00517109 
00517200 
00517299 
00517300 
00517301 
00517309 
00517400 
00517500 
00517600 
00517700 
00517800 
00517900 
00517909 
00517980 
00518000 
00518100 
00518200 
005J8299 
00518350 
00518400 
00518500 
00518509 
00518550 
00518560 
00518569 
00518600 
00518700 
00518800 
00518900 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 



0263*1 
0266*3 
0268*0 

0268*1 
0272«0 
027410 
0275*0 
027712 

0279» 1 
0279*1 
0283*0 
0285*3 
0285*3 
0288*2 
0293*1 
0295*3 
0295*3 
0296*0 
0296*0 
0296*0 
0296*3 
0302*1 
0303*1 
0305*0 
0308*2 
0310*0 
0310*0 
0313*0 
0313*0 
0313*0 
0314*3 
0314*3 
031712 
0317*2 
031712 
0319*2 
0321*2 
0326*0 
0328*2 
033111 
0331*1 
0331U 
033313 
0335*3 
0337*2 
0340*1 
O340U 
0341*0 
0343*2 
0344*0 
0344*0 
0345*1 
0345*1 
0345*1 
0347*3 
0350*1 
0354*0 



#. ' 






$ SET OMIT 



* SET OMIT 



end;* 

IF NOT 
BEGIN 

s NOT 



FlB[53,[l*l3 THEN 



SHAREDISK 
GO TO EOF; 

end; 

a NOT SHAREDISK 

codem; go to par; 
end;* 

dkadr+abs(okaoR)-i;% 
if hea0erc7kdkadr then go to sfui_u% 
if not diskaddress then go to sfulux 

CODE*FIBtl6 3. C 33 I 15 j; UNITYPE*F IB[ 1 3 3 . 

FOR 1*0 STEP 1 UNTIL UNITYPE DO* 
SET OMIT ■ SHAREDISK 

BEGIN IF NOT TANKC I] , [ 1 9 * 1 3 THEN BEGIN 
POP OMIT 



C10I93-HX 



PCCTANKCI33); WAIT END;* 



SET 



$ SET 



POP 
SET 



OMIT 

OMIT 

OMIT 
OMIT 



* NOT SHAREDISK 
IF TANKt I],C27in 
= SHAREDISK 
IF CMEMCC0DE3 EQV 



THEN GO TO SEMPTY;* 
ADDRESS)snOT THEN GO TO SFULi; 



at NOT SHAREDISK 
COOE*MEMCCODE-*23,tl8J153;% 



end;% 

SET OMIT 
SET OMIT 



NOT SHAREDISK 

SHAREDISK 
PCTANK[0]*FIAG(FIBC16])#AODRESS#XCH#OJ% 
POP OMIT 

P(FLAQ(FI8C19 3),TANK#PRL*0EL);X 
FlBtl6],C33«l5]*cODE*MEM[COOE-2 3.ti8U5];x 
FlB[l9].[33Jl53*-CODE + i;% 
GO TO SFULi;* 



semptyj 

$ SET OMIT 
$ SET OMIT 

$ POP OMIT 



■ NOT SHAREDISK 

= SHAREDISK 

P<TANKCn«-FLAG(FlBCl6mC00EC33«33ll53#ADDRESS#XCH#O; 



SP1 



% 

DKURi 
% 



FIBC133.[10I9]*1JX 
*(FLAG(FlBC19])&(C0DE+l)C33t33ll5]»CTANKCI]]#PRL#DEL);% 

FlBCl33,tlOJ9 3<-UNITYPE+i;% 
GO TO SFULL;% 
STREAM(D«.IOD); BEGIN DS*7 LIT "ACCEPT*" END;X 



IF FPBCFNi.JM + 33,tft2l6]a43 THEN 
PCCNOT 1) INX I0D*16»C0M*DEL); 

riB[53.U3*2J*0j% 



go eof; 3JDUMMY 
go to sfull;x 



pcxit); 

$ set omit = not(timesharing) 
dc15j p(fib[183,c33:153 & dk adr 1 1 * «? * 1 3 & 

CDKAtJR,C2»n AND C DKADR , C FF 3 = ) AND 
I0D*UC-13)*C0M); 

ijspolish; 

ADDRESS S=TANKtNOT( 4- (1=2))]; 
TANKCNOT 4 3 * <=T ANK [ NOT 33j=0; 
IF I THEN P(FIBCl8],C33M53fRTN)i 



CTANKCNOT 3 ] *0 > K 32 *47 * 1 3 * 



00519000 
00519100 
00519110 
00519119 
00519130 
00519140 
00519149 
00519160 
00519200 
00519300 
00519400 
00519500 
00519600 
00519700 
00519799 
00519800 
00519801 
00519809 
00519900 
00519999 
00520000 
00520001 
00520009 

00520100 
00520200 
00520209 
00520299 
00520300 
00520301 
00520400 
00520500 
00520600 
00520700 
00520710 
00520719 
00520799 
00520800 
00520801 
00520900 
00521000 
00521100 
00521200 
00521300 
00521310 
00521400 
00521500 
00521600 
00521700 
00521800 
00521810 
00521813 
00521814 
00521815 
00521816 
00521817 
00S21818 
00521819 



0354:2 
0354*2 
0355:3 
0356« 1 
0356'! 
0356*3 
0356*3 
0356*3 
0358*0 
0358*0 
0359*2 
0361*0 
0362*2 
0366*0 
0367*0 
0367*0 
0371*0 
037l*0 
0371*0 
0373*1 
0373*1 
0376*0 
0376*0 
0376*0 
0378*3 
0381*0 
0381*0 
0381*0 
0383*0 
0383*0 
0384*3 
0389*1 
0391*3 
0392*1 

0392*1 
0392*1 
0392*1 
0395*2 
0395*2 
0398*0 
0401*1 
0404*1 
0404*3 
040712 
0410*3 
0415*0 
0415*0 
0417*2 
0417*2 
0417*3 
0417*3 
0420*0 

0425*0 
0426*2 
0427*0 
0429*3 
0433*0 






IF ADDRESS NEQ THEN 

PC ADDRESS, MKS, 9, BUKCNTRL); 
ADORESS«=(I s O)+i; 
PCTANK»ADDRtSS#U»COM)J 
DC2:: PCXlTj; 
dcn1* dcn2i spin* 
$ set omit = timesharing 
end algqlread; 



00521820 
00521821 

00521822 
00521823 
00521824 

00521825 
00521830 
00524700 



p 

c 
c 
c 
c 


0435?0 
0435*3 

0437*1 
0439*0 
0440*0 


T 
T 
T 


0440*1 
0441*0 
0441*0 



size* 0442 words 



PROCEDURE INPUTlNmEN>FlLX,DKAOR>ACT,Fl*FRMT>USX»EOFL»PARL);X 

START 



VERSION OF 
12/1/64% 



COMMENT ESPOt 
BY L.R« GUCK 
VALUE FI'* 

act;* 
name filx>* 

LISXU 
ARRAY TE^E*J*% 

FRMTC*3IX 
INTEGER ACr,% 

fi;% 
real dkadr;s 
real eoel** 

begin comment local variables;* 
real junk2«9,% 

ALG0LREA0=13*% 

SELECT=14^% 

JUNK1 ~ 17*% 

L.STRN«i9JX 
REAL BLKCNTL a 5/% 
REAL SAVEBUFFsEOFL* COD£l=PARL ; 
INTEGER AEXP«FRMT;X 
ARRAY ARRY«LISXC*];« 
ARRAY REALR0W=TEN"lt*3U 
REAL F * +0;% 
REAL TLSTRNsF+i;* 
REAL 8UFF*TLSTRN+i;« 
INTEGER BSIZEsBUFF + lU 
ARRAY FIB=BSIZE+1C*J;% 
REAL AODRS»FlB+i;* 
REAL SGNeADORS+i;% 
REAL HT«SGN+"ij% 
REAL W1*WT>1J% 
REAL CCP * Wlf DIVR ■ Will 
RFAL W2bW1+1;% 
REAL TYP = W2JX 
REAL D-W2+i;% 
REAL ESIG= 01% 
REAL D1-D + 1U 
REAL D2 B Dl+l;% 
REAL H«D2+1#% 
RFAL SKIP*W<MJ% 



ALGOL READ INTRINSIC* 



00600000 T 0000*0 

OF REL SEGMENT; DISK ADDRESS ■ 

00600100 T 0000*0 

00600200 T 0000*0 

00600300 T 0000*0 

00600400 T 0000*0 

00600500 T 0000*0 

00600600 T 0000*0 

00600700 T 0000*0 

00600800 T 0000*0 

00600900 T 0000*0 

00601000 T 0000*0 

00601100 T 0000*0 

00601200 T 0000*0 

00601300 T 0000*0 

00601400 T 0000*0 

00601500 T 0000*0 

00601600 T 0000*0 

00601700 T 0000*0 

00601800 T 0000*0 

00601900 T 0000*0 

00602000 T 0000*0 

00602050 T 0000*0 

00602100 T 0000*0 

00602200 T 0000*0 

00602300 T 0000*0 

00602400 T 0000*0 

00602500 T 0000*0 

00602600 T 0000*0 

00602700 T 0000*0 

00602800 T 0000*0 

00602900 T 0000*0 

00603000 T 0000*0 

00603100 T 0000*0 

00603200 T 0000*0 

00603300 T 0000*0 

00603400 T 0000*0 

00603500 T 0000*0 

0®603600 T 00Q0*0 

00603700 T 0000*0 

00603800 T 0000*0 

00603900 T 0000*0 

00604000 T 0000*0 

00604100 T 0000*0 



00111 



t 



€ 



• 



REAL 

REAL 

REAL 

INTEGER 

INTEGER 

REAL 

REAL 

LABEL 



• 

• 



DEFINE 

SUBROUTI 
BEG 



C MR v 
FAWs 

CODE 

CSI2 

SCFT 

FLG 

UOEC 

GA,G 

FREE 

NFRA 

NCA2 

EQUT 

GETC 

STAR 

ASLS 

FMOU 

PHRA 

LOGI 

DTYP 

RTYP 

RIPR 

ITYP 

FOUT 

COMA 

COMM 

P a 

TENS 
NE CKP 
IN% 

IF F 



SKIP + 
CHR + 1 
«FAW + 
E-CCD 
R - C 
= SCF 
LR-FL 
ACGR 
LD*ST 
C1»AT 
,NNM8 
,EAT1 
OMA,G 
T,CT, 
T,BS, 
TA,FM 
S,lNL 
» FLA 
E,OTY 
E^RBL 
TN*RF 
E*FlN 
,FTYP 
,COMM 

ent l 

PQLIS 
= Pi 

b; co 



1;* 

it 

\)% 
e+i;i 

SIZE+1 
TR + i; 

6+tJ 

TY,GTB 

RT,NMR 

S,HR1, 

*NQTNU 

,EATUP 

ETC1*M 

CTA,CT 

BR,AEX 

OUT, SI 

OOP,FL 

GBIT* 

PE,ALF 

F*RFA» 

PRTN,R 

#FM0UT 

E*FA*E 

,CQMB, 

ABELS 

H*,* 

045753 

MMENT 



% 



,GTCGTD»NuMXIT,* 

CL*HERE*N0SlG»LPTW0,N0TNUM2,Li*LtP2*X 

NSG>L2Pl,FlNXP,NCAl,NMINUS,N0TAT,X 

M*RNOTNUM* INSERTS AST* QRT*QRTN#'X 
,NQU0T,GET0>GTRT7,ASTRX,CHK0CT,X 
AXI* 

8* CTC t % 

PL#ISA,ISB, ERROR, * 

,S,LFPAR,RTPAR,SCALE,STRNG,SLASH,% 
DW»JMP,* 

A,XTYPE*% 

RIPART,RD0NA,RDONE*RFC»REXP,X 

FPART,GETNUM,GRTN,% 

Ml,S2, 

TYPE,* 

comc,rerra;% 

ARE LlSTEO IN SAME ORDER THEY APPEAR;! 



604000000*;% 
CHECK FOR PRESENCE 



bit;* 



ILX. [181151 
BEGIN IF N 



END 
SUBROUTI 

BEG 



BSIZE 
END ELSE* 
BSIZE*P0LISH(M 
BUFF«-C*FILX)X8S 

}% 

NE REAOS;% 

COMMENT RELEASE 
IN* 

P{XCH>; COMME 

IF ACT*2 T 

POLISHC 

if p then* 

BEGIN 



< 1 THEN* 

ot filx.c18i 153 then* 
begin;stream(a<-[Realrowco]] jb*0);* 

begin si*a; di*a; si*si-i6; 
skip 2 sb;% 

IF SB THEN TALLY * If* 

a * tally;* 
end;* 
if not p then* 

begin pcfilx,14,c0m*0el);* 

FILX.C18U53 «• l)% 

fnd;* 

END'* 

<• realrqw.c8u0];* 

ks,dkadr*i,filx*algolread);* 
IZECe* 38: 103 ; 



buffer;* 

nt flag to top of stack;* 
hen comment read release;* 
mks»dkadr,0>filx,al60lread);x 

lstrn * tlstrnu 
if filx.[18u5]>1 then 

filxcnot 4]*filxcn0t 33*0 else 



00604200 
00604300 
00604400 
00604500 
00604600 
00604700 
00604710 
00604800 
00604900 
00605000 
00605100 
06605200 
00605300 
00605400 
00605500 
00605600 
00605700 
00605800 
00605900 
00606000 
00606100 
00606200 
OO6O63OO 
00606400 
00606500 
00606600 
00606700 
00606800 
00606900 
00607000 
00607100 
00607200 
00607300 

00607400 
00607500 
00607600 
006077QO 
00607800 
00607900 
00608000 
00608100 
00608200 
00608300 
00608400 
00608500 
00608600 
00608700 
00608800 

00608900 
006Q9000 
00609100 
00609200 
00609300 
00609400 
00609500 
00609600 
00609700 



0000«0 
000050 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0001*0 
0001*0 

0002*1 
0003*3 

0005*3 
0006*2 
0006*3 
0007*2 
0007*3 
0008*0 
0008*1 
0009*3 
OQii*0 
0011*0 

0011*0 

0012*2 
0012*2 
0014*3 
0016*3 
0017*0 
0017*0 
0017*0 
0017*0 
0017*1 
0018*0 
0019*3 
0019*3 
0021*0 
0022*1 



• 



SUBROUTINE 
PFC?N 



GAS 



GAC 



IF FILX, Ct8t 153 * 1 THEN* 

PCFILXf 14,C0M);* 
PCXIDJX 

end;% 
ckpb;* 

if sgn.u5m3 then %%% utyp*sgn . [45 ! 1 3 i see u-phrase declr 

begin csize*8><bsize; buff«-pc 0* t buff3 * of inx ) end ; 
end reads;* 

comment subroutine used by free field;* 
gncr;* 

COMMENT TH T S SUp-POUTINT CFTS CK7PACTFPS F0P5K 

^HEN REQUIRED;?: 
IF WT > THEN GO TO GAC;X 

COMMENT BUFFER IS EMPTY-FILL ITi% 
P(0)U 

reads;* 

wt «■ bsize x 8/ comment wt - * of characters in buffer;* 

BUFF «• P(-0fO# CBUFF3,CCX);* 

COMMENT GET CHR FROM BUFFER;* 
STREAMC* 

P5 

P4 

P3 

PI 
BEGIN* 

SI 



0,* 

BUFFf* 
IF WT < 

TYP);* 



63 THEN WT ELSE 63*% 



FGNC 



GNCHCJ 



*■ P4;* 
ci «• Ci + pi;* 

GO TO FGNC; 
GO TO GNCHCJ 
P3CIF SC i M " 

si*si+i;x 

TALLY * TALLY +1);* 
COMMENT RETURN A -1 IF 
01 «■ LOC P5U 

DS «. g lit ,? + ooooooi«;* 

GO TO crtn;* 

TALLY * TALLY + \i% 



COMMENT DEBLANK-THEN 

COMMENT GET NCR;* 

THEN JUMP OUT TO GNCHC;* 



ALL WERE BLANK;* 



GET NCR;* 



01 *• LOC P4J* 

di <• di - i;* 
ds *■ chr;* 
crtn5 p3 * tally!* 

P4 <■ SlJSX 

end;* 

PCWT»XCHfSUBf ,WT*STD); 

BUFF «• p;* 

IF P(DUP) < THEN BEGIN 



pcxchj; 

end gncr;% 
real subroutine llstelement ; 

BEGIN 

if lstrn<0 then go to error 
p(addrs».addrs>isn) ; 
addrs«.lisx i 

LlSTELEMENT*? ; 

END OF LlSTELEMENT ; 



COMMENT WT «■ WT'TALLY;* 

pcded; GO TO ga end;* 

COMMENT RETURN LITERAL TO TOP;* 



00609800 
00609900 

00610000 
00610100 
00610200 
00610210 
00610220 

00610300 
00610400 

00610500 
0061 0600 
00«»1C?G(, 
00610800 
00610900 
00611000 
00611100 

00611200 
00611400 
00611500 
00611600 
00611700 
00611800 
00611900 
00612000 
00612100 
00612200 
00612300 
00612400 
00612500 
00612600 
00612700 
00612800 
00612900 
00613000 
00613100 
00613200 
00613300 

00613400 
00613500 
00613600 
00613700 
00613800 
00613900 
00614000 
00614100 
00614200 
00614300 
00614400 
00614500 
00614505 
00614510 
00614515 
00614520 

00614525 
00614530 
00614535 
00614600 



T 

T 

T 

T 
T 
T 

T 
T 
T 
T 

T. 

1 

T 
T 
T 
T 

T 

T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 

T 
T 
T 

T 



002610 
0027*3 
002910 

0029*1 
0029«1 
0030*0 
0030*3 

0034*0 
0034*1 
0034*1 
0035*0 

0035*C 
0035*0 

0036*1 
0036*1 

0036*2 
0038*0 
0039*1 
0040*3 
0040*3 
0041*0 
004111 
0041 »2 
0044*0 
0044*2 
0044*2 
0044*3 
0045*1 
0045*2 
0045*3 
0047*1 
0047*2 
0048*0 
0048*0 
0048*1 
0049*2 

0049*3 
005Q*0 

0050*1 
0050*2 
0050*3 
0051*0 
0051*1 
0051*2 
0052*3 
0053*1 
0055*1 
0055*2 
0055*3 
0056*0 
0056*0 
0057*1 
0058*0 
0058*3 
0059*0 
0059*1 



< 

i 

i 

i 



• 
• 



% * * * 
% NOTE TH 
% EITHER 
LABEL 



DEFINE 



E C L A R 
AT CST REFER 
A NUMBER* AN 

UERR 

UTYPE 

UENDNUM 

UL1 
UL2 
UL3 
UL4 
UL5 
UL6 

fmteRR 

UEXP 



UBUILD 



A T I 

S TO THE 
UNQUOTED 



WT *» 



Wl #* 



UVAL 

UNUM 
UADDRS 

UH 
U8UFF 



UCHCNT 

USCHCNT 

UDEC 



= W2 #* 

Dl #, 
: UDECLR *# 

D2 ** 
FL6 #* 



SKIP t, 

FAW #* 

#* 



USGN 

UEXP 

UTYP 

UNLff 
UQST 

ULIS 

UD 
UW 
UFRE 



SGN *» 

CATED » 
RNG = 
T * 



SGN, 
SGN. 
SGN, 
SGN. 
SGN, 
SGN, 



C 47 8 1 3 

£46*13 
[45*13 
[44113 
C43« 13 

[42*13 



SUPROUTIN 
BEGI 
IF C 
THEN 



EFIEL 
UGET 
UGOO 
UEOW 
UALL 

E UGN 

N 

HR>CS 
BEGI 
UGET 
IF U 



#* 
#* 
*> 



[36:63 *« 
[30*63 *t 
C29: 13 #, 



- SGN, 

= SGN. 
D= SGN, 
RECORD * 
FEDCUGOOFED1) * 



DONE 

ch; 



IZE 
N 

RECORD 
NLOCATE 



%% UGNCH 
%% BUFFER 
XX ADJUST 
XX WE NEE 
} XXX 

D XXX 



N S 

CONST 
STRI 
XXX 
XXX 
XXX 
XXX 
XXX 
XXX 
XXX 
XXX 
%%% 
XXX 
XXX 
XXX 
XXX 
XXX 
XXX 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 

%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 
%%% 

?! *} * 

XXX 

%xx 

XXX 

XXX 
XXX 
BEGIN 
BEGIN 
WSUCH 
GO TO 
GETS 
» GET 
S 8UF 
DAN 
GET A 
IF HA 



FOR U-PH'RASF *** 
RUCT BEGIN SCANNED. THE CST IS 
NG» OR A QUOTED STRING, 
BRNCHTO FOR DATA ERROR, 
BRNCHTO FOR U-PHRASE EDITING, 
BRNCHTO FOR END OF NUMBER SCAN, 
BRNCHTO FOR EFFICIENCY IN UCH. 
BRNCHTO FOR EFFICIENCY IN uCHECKT 
BRNCHTO FOR EFFICIENCY IN STRINGS 
BRNCHTO FOR STRING-HANDLING LOOP, 
BRNCHTO FOR UCHECKIT (PEND-OF'CST ) 
BRNCHTO FOR NO STRING STOREt 
BRNCHTO FOR ILLEGAL FORMAT, 
IS VALUE OF EXPNTCOF CST AS NUM), 
OR IT IS THE SHIP-IT-ANYHOW TOGGL 
FOR THE 1-ST CHR OF QUOTED STRING 
OR IS USED AS TEMPORY BY UGETSGN, 
IS > IF HAVE NOT YET IDENTIFIED 
CST & SO MUST BUILD UH INTO UBUFF 
IS > IF SHALL BRANCH TO ENDNUM 
IF HAVE HIT END OF FIELD WIDTH, 
IS ALSO USED AS TEMPORARY COUNTER 
OF OCT DIGITS IN OCTAL NUM PART, 
IS VALUE OF CST IF CST IS A NUM f 
AND IS USED AS TEMPORARY STORAGE, 



IS TRUE IFF CST IS NUMBER, 

STORES LIST ADDRESS REFERRED TO 

BY THE ULIST DEFINE (BELOW). 

IS CURRENT CHARACTER OF CST, 

IS SIX OR LESS CHARACTERS OF CST# 

ALSO IS USED AS TEMPORARY BY 

SUBROUTINE UCHECKIT. 

IS CHARACTER COUNTER FOR CST, 

IS STRING CHR, COUNTER FOR UBUFF, 

IS VALUE OF DECIMAL PART OF CST 

(IF CST IS NUMBER)* AND IS ALSO 

USED AS TEMPORARY STORAGE. 

IS TRUE IFF CSTUS NUM) IS NEGTIV 

IS TRUE IFF UEXP IS NEGATIVE, 

IS TRUE IFF IN OR JUST USED UPHRS 

IS TRUE IFF HAVE NOT LOCATED CST. 

IS TRUE IFF CST IS QUOTED STRING, 

IS TRUE IFF UCH HAS TRIED TO GET 

AND/OR HAS GOTTEN A NEW LIST ADRS 

STORES ORIGINAL VALUE OF D, 

STORES ORIGINAL VALUE OF W, 

IS TRUE IFF IN SPECL // FREEFIELO 

P(CHR*0); READS ENO ## 

UEXP*UGOOFEDi; GO TO UERR END #* 
CNT #* 

BR # ; 

THE NEXT CHARACTER FROM THE 

S A NEW BUFFER WHEN NECCESSARY, 

F* AND BUMPS CHR BY 1, 

EW BUFFER* CALL READS TO GET ONE, 

NEW RECORD, 
VE NOT YET LOCATED CST* THEN 



00614605 
00614610 
00614615 
00614620 
00614625 
00614630 
00614635 
00614640 
00614645 
00614650 
00614655 
00614660 

00614665 
00614670 
00614675 
00614680 
00614685 
00614690 
00614695 
00614700 
00614705 
00614710 
00614715 
00614720 
00614725 
00614730 
00614735 
00614740 
00614745 
00614750 
00614755 
00614760 
00614765 
00614770 

00614775 
00614780 
00614785 
00614790 
00614795 
00614800 
00614805 
00614810 
00614815 
00614820 
00614825 
00614830 
00614835 
00614840 
00614845 
00614850 
00614855 
00614860 
00614865 
00614870 
00614875 
00614880 
00614885 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0059J 
0059! 
0059S 
0059« 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059? 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059? 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059* 
0059» 
0059* 
0059* 
0060* 
0Q60* 
0060* 
0061* 
0063*0 



* 



n 



• 



• 



THEN UCHCNT*0 ; XXX ZERO CHAR. CNTER, FOR NEW BUFFER SCAN. 

END ; 
CHR«-CHR + 1 ; XXX INCREMENT CHARACTER COUNTER. 
STREAM(Pl+0*P2«-BUFF*P0«-0) ; %%% NOW SET CHARACTER AND BUMP BUFF 

BEGIN DIALOG P2* Dl«-DI«-lj SK-P2** DS*CHRl P2«-SI END ; 
BUFF*P j XXX BUFF IS SET TO NEW ABS ADDRS CBUFF+1). 

uh«-p ; xxx character is stored in uh, 
end of u«nch ; 
subroutine ubuffit ; %%% stuffs uh into ubuff 
begin xxx and bumps the string 

UBUFF«-UH & UBUFF[12:i8?30] ; 
USCHCNT*USCHCNT+1 , 

END OF UBUFFIT * 



FROM THE RIGHT 
CHARACTER COUNTERf 



SUBROUTINE 
BEGIN 



UCH i XXX UCH IS THE CONTROL FOR UGNCH. UCH WATCHES OUT 
%%% FOR END-OF-W AND* IF NOT IN "STRING"* SCANS 
%%% OVER IN-LINE COMMENTS (/,.,*) AND STORES NQN- 
XXX BLANK PORTION OF CST IN UBUFF FOR FUTURE USE 
IF CST TURNS QuT NOT TO BE A NUMBER. UCH ALSO 
HANDLES END-QF-RECORD SITUATIONS C/,.„ OR * ) , 
XXX IF HAVE HIT END*OF-W (WsFlELD WIDTH)* THEN 



WE ARE NOT IN THE STRING SECTION* WE 
GO UENDNUM END XXX BRNCHTO END-OF-NuM, 



W 



» t * 



CHR, CNTER, 



%%% 
IF UE'OW THEN 

BEGIN 

IF UBUlLO*0 XXX IF 

THEN BEGIN PCOEL)* 

END 
ELSE %%% ELSE WE ARE STILL INSiDE FIELD-WIDTH 

BEGIN XXX STILL SOME FIELD WIDTH LEFT, 

ugnch; uchcnt*uchcnt+i ; xxx get chrter* bump 

IF NOT UQSTRNG THEN XXX NOT IN A QUOTED STRING, 
BEGIN 

WHILE UH = V" DO %%% 

BEGIN XXX 

DO UGNCH UNTIL 

IF CHR*1 THEN 

BEGIN 

IF UH»"* H 

IF UHss"*" 

BEGIN 
END i 
END * 
UH="*« THEN XXX W£ SET UH*DELIM£TER* AND IF THERES 
BEGIN XXX MORE LIST* WE GET A NEW RECORD. 
UH*" "J IF LSTRN^O THEN UADDRS<-LISX ; 



WE"VE 
CHR»1 



HIT AN END-OF-RECORD MARK 
OR AN INLINE CMMNT C'V , , ,s" ) 
OR UHs" = " OR UH*"«-" ; 



THEN GO TO UL1 * 
THEN 

chr«-csize; 



ULl* UGNCH END * 



IF 



SGN*S6N OR 
IF LSTRNSO 
ENO 1 
IF UBUILD^O 
THEN UBUFFIT * 
END ; 

end ; 

ENO OF UCH } 
BOOLEAN SUBROUTINE UDELIMCHK i 

BEGIN 

UDELIMCHK«-UH»"*" 

END OF UDELIMCHK 
DEFINE UCHECKIT ■ 



32 ; 

THEN 

XXX 

XXX 



XXX SETS ULIST -s 
UGETRECORD J 



TRUE, 



WE 

so 



HAVE 
MUST 



NOT YET 
SAVE UH 



IDENTIFIED 

IN UBUFF, 



CST* 



M H 



XXX IS TRUE IFF HAVE 

XXX DELIMITER NOT IN 

OR uH«"* n OR UEOW * 



ENCOUNTERED A 
A QUOTED STRING, 



OR UH^ 

* 

XXX UCHECKIT IS USED WHENEVER THE SCAN HAS 

XXX TERMINATED. UCHECKIT CHECKS FOR THE PROPER 

XXX DELIMITER AND TAKES THE ASSOCIATED BRANCH, 



00614890 
00614895 
06614900 
00614905 
00614910 
00614915 
00614920 
00614925 
00614930 
00614935 
00614940 
00614945 
00614950 
00614955 
00614960 
00614965 
0«614970 
00614975 
00614980 
00614985 

00614990 

00614995 

00615000 

00615005 

00615010 

00615015 

00615020 

00615025 

00615030 

00615035 

00615040 

00615045 

00615050 

00615055 

00615060 

00615065 

00615070 

00615075 

00615080 

00615085 

00615090 

00615095 

00615100 

00615105 

00615110 

00615115 

00615120 

00615125 

00615130 

00615135 

00615140 

00615145 

00615150 

00615155 

00615160 

00615165 

00615170 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0063*0 
0065*0 
0065*0 
0066*1 
0067*3 
0069*1 
0069*3 
0070*1 
0070*2 
007i *0 
007l*0 
0072*3 
0074*0 
0074*1 
0075*0 
0075*0 
0075*0 
0075*0 
0075*0 
0075*0 

0075*3 
0076*1 
0076*3 
0078*1 
0078*1 
0078*1 
0078*3 
0081*1 
0082*1 
0082*3 
0084*0 
0084*0 
0088*1 
0089*0 
0089*2 
0090*3 
0091*2 
0094*0 
0094*0 
0094*2 

0095*1 

0095*3 

0098*2 
0099*3 
0103*0 
0103*0 
0103*2 

0105*0 
0105*0 
0105*0 
0105*1 
0106*0 
0106*0 
0110*0 
0110*1 
0110*1 
0110*1 



I 
I 

i 
i 

i 
f 
i 
i 



IF 
IF 



m 



UHs 

NOT 

B 

U 

W 



• 



u 

G 

E 

UGOOFE 

%%% EN 

BOOLEAN SUB 

BEGIN 

IF P(U 

UGETSG 

END OF 

BOOLEAN SUB 

BEGIN 

IF NOT 

8 

I 

I 



•»*•• THEN UA 
(CUBUFF*UH/ 
EGIN 

QSTRNG«.UBUI 
hile UCHCNT 
BEGIN 
UCH ) 
IF ULIS 
IF UHs" 
IF (U8U 
THEN UB 
END * 
L2J W*UW * 
TO COMM 
ND ) 

0(2) #J %%% 
OF UCHECK 
ROUTINE UGE 



XXX UCHECKIT WILL POSITION UH APPRQPIATELY 
XXX (PRIOR TO DELIMITER CHECKING) IF THE 
%%% MINIMUM FIELD WIDTH (UD) HAS NOT BEEN 
XXX EXHAUSTED, 

LLDONE ; %%% THE * TERMINATES THE READ STMT, 
"*") AND UH*" ") THEN 

LD*0; WM23J D*UD * 

<D DO XXX SCAN OFF UNTIL AT LEAST 

%%% D CHARACTERS HAVE BEEN PASSED i 

T THEN GO TO UL2 J XXX HAVE ENCOUNTERED AN «■ , 
*" THEN UALLDONE S XXX THE * TRMNTS THE READ. 
FF OR UVAL+UHX"*") AND (UH* M " OR NOT UVAL) 
UFF«-UBUFF AND UVAL ELSE UGOOFED(l) i 

xxx Restore w to its original value* 

J XXX AND MAKE NORMAL EXIT. 

WAS NOT "*"» "*"* OR " " SO WE ERROR EXIT, 
IT, 

TSGN ; XXX IS TRUE IF SIGN*"-"; IF SIGNC+»*#») 

%%% EXISTS* UGETSGN FETCHES A NEW CHAR. 



h s"-",dup) or uh»"*" or uh* w & m then uch ; 
n*polIsh ; 

UGETSGN i 
ROUTINE USD 



UOSTR 
EGIN 
F UEOW 
F NOT( 

BE 

ua 

IF 

TH 



ELIMCHK } 
NG THEN P(UDEL 



THEN 
UH*"" 
GIN 

STRNG 
NOT 

EN 8E 
IF 
SG 
UC 
EN 



UGOOFED( 
" OR UEXP 

♦o; UCH 

P(UDELIMC 
GIN 

UH/""" T 
N«-SGN OR 
Hi 

D ; 



F 

E 

USDELI 

END OF 

% * * * E 



EN 
LSE PC 
ND i 
MCHK«-P 

USDEL 

N D 



D 
UEXP«-CO J 



OLISH 

IMCHK 

F 



XXX IS TRUE IF CURRENT CHARACTER (UH ) 
XXX IS A DELIMITERS OR * OR BLANK); 
IMCHK) ELSE XXX IF UH=RI6HT HAND 

XXX QUOTE OF QUOTED STRING* 
3) i XXX THEN ONE AND POSSIBLY TWO 
) THEN XXX CHAR ARE SCANNED UNTIL UH 

XXX IS EITHER A DELIMITER OR 
; XXX THE FIRST CHARACTER OF THE 
HK,DUP)*XX NEXT CONCATENATED STRING, 

HEN uGOOFEDM) * 

16 ; %%% SETS UQSTRNG n TRUE, 

XXX DO ERROR-EXIT IF WE ARE IN 

XXX QUOTED STRING AND J EXCEED 

XXX W OR ENCOUNTER 

XXX A NON-QUOTE* NON-DELIMITER 



U-PHRASE DECLARATIONS* 



label c*x*a*i*r*e»0*l*z»zw2*zd*swt ; 

go to start; comment go around free field code; 

comment free field format * 
freflos! p(0*0*0#o*o»o)i comment push up stackjx 

LSTRN * OiX 

WT * BSlZE x 8i COMMENT WT * # OF CHR IN BUFFERiX 
BUFF * P(0*0*E8UFF3#CCX)iX 
5TRT* ADDRS ♦ LISX; COMMENT ADDRESS OF LIST ITEMiX 

IF LSTRN < THEN BEGIN COMMENT CALL READ AND EXITiX 

P(l)iX 



00615175 
00615180 
00615185 
00615190 
00615195 
00615200 
00615205 
00615210 
00615215 
00615220 
00615225 
00615230 
00615235 
00615240 
00615245 
00615250 
00615255 
00615260 
00615265 
00615270 
00615275 
00615280 
00615285 
00615290 
00615295 
00615300 
00615305 
00615310 
00615315 
00615320 
00615325 
00615330 
00615335 
00615340 
00615345 
00615350 
00615355 
00615360 
00615365 
00615370 
00615375 
00615380 
00615385 
00615390 
00615395 
00615400 
00615405 
00615410 
00615415 
00615420 
00615500 
00615600 
00615700 
00615800 
00615900 
00616000 
00616100 



T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



110*1 
110*1 
110*1 
110*1 
11011 
110*1 
110*1 
110*1 

110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
110*1 
111*0 
111*0 
116*0 
116*1 
116*2 
117*0 
117*0 
120*0 
120*2 
123*0 
124*2 
125*0 
128*0 
129*1 
130*0 
132*2 
133*3 
135*0 
135*0 
135*0 
136*1 

136*1 
136*2 
136*3 
136*3 
136*3 
136*3 
137*2 
137*2 
139*2 
140*1 
141*2 
143*0 
143*3 
145*0 



i 







NMRCL ! 



HERE* 

NOSlGl 

IPTWO* 

N0TNUM2: 

LI » 

L1P2* 

NFRACi: 
ATS: 



HRll 

NSGl 
L2Pl» 



FlNxPl 

NCAiJ 

NMINUSi 

NOTATI 
NCA2I 



NNMBl 

notnum; 



reads;% 
end;* 
gncrj comment get a character to 
esig «■ divr <- o; comment set exponent and 

TO zero;* 

PCDUP) « "•") THEN GO TO HEREU 
"♦" THEN 60 TO HEREU 
"«" THEN GO TO NOSIGJJS 



TOP OF STACKJ% 
FRACTION PART* 



IF (SGN * 
IF PCDUP) 
IF PCDUP) 

pcded;% 
gncr;% 

IF PCDUP) 
GNCRU 
IF PCDUP) 



> 9 THEN GO TO 

> 9 THEN GO TO 



NQTNUMJ* 
N0TNUM2;% 



GO TO NFRACm 



TO NFRAC1/X 



GO TO notat;% 



PCDUP) s 
"+« THEN GO 
"&" THEN GO 

COMMENT 
COMMENT 



TO 
TO 

1ST 
2ND 



") THEN 
HRU% 

nsg;% 



digit;% 
digit;* 



P(XCH#10*MUL*4j|% 
gncr; GO TO LPTHOjX 
IF PCDUP) i "," THEN 

pcded;* 

GMCR'X 

if pcdup) > 9 then go 
pcxch#io»mul>+);% 
divr «■ divr +1)1 
gncrj go to l1p2jx 

IF PCDUP) t "?" THEN 

PCDEDU 

GNCR^* 

IF CESIG * 

IF PCDUP) s 

IF PCDUP) / 

P(DEL)iX 

gncr; 

GNCRJ 

IF PCDUP) > 9 THEN GO TO FlNXPi* 

P'<*CHMO*MUL» + )J* 

gncrj go to L2Pi;% 

IF P * "#" THEN GO TO NCAlIX 
gncr; 60 TO FINXP*% 
IF ESIG THEN P(CHS>;% 
ESIG ♦ PJ* 

pcrnn 

if p * "*" then go to nca2;% 

gncr; go to notat;* 

if sgn then pcchs)/% 

if pcesig-divr^dup) * then% 

BEGIN% 

P(DEL)J% 

pc[addrs3#isd)j% 
go to strtx 

end;* 
if pcdup) > then^ 

PCTENCP]>MUl)% 
EUSE« 

PCTEN[-P3*/);% 
P([ADDRS3*STD)U 
GO TO strt;% 

IF PCDUP) t ",'♦ THEN GO TO RNOTNUM;* 
PCDEL)/% 
PC03U 



GO TO HR1JX 



00616200 
00616300 

00616400 
00616500 
00616600 
00616700 
00616800 
00616900 
00617000 
00617100 
00617200 
00617300 

00617400 
00617500 
00617600 
00617700 
00617800 
00617900 
00618000 
00618100 
00618200 
00618300 
00618400 
00618500 
00618600 
00618700 
00618800 
00618900 
00619000 
00619100 
00619200 
00619300 
00619400 
00619500 
00619600 
00619700 
00619800 
00619900 
00620000 
00620100 
00620200 
00620300 
00620400 
00620500 
00620600 
00620700 
00620800 
00620900 
00621000 
00621100 
00621200 
00621300 
00621400 
00621500 
00621600 
00621700 
00621800 



0145*1 
0146*0 

0146*0 
0147*0 
0148*1 
0148*1 
0150*1 
0151*2 
0152*3 
0153*0 
0154*0 
0155*1 

0156*0 
0157*1 
0158*1 
0159*2 
0160*3 
0161*0 
0162*0 
0163*1 
0164*1 
0165*2 
0167*2 
0168*3 
0169*0 
0170*0 
0172*0 
0173*1 
0174*2 
0174*3 
0176*0 
0177*0 
0178*1 
0179*1 
0180*2 
0181*2 
0183*2 
0184*2 
0185*0 
0185*1 
0186*1 
0187*2 
0188*2 
0190*0 
0190*2 
0190*3 
0191*1 
0191*3 
0191*3 
0192*2 
0193*2 
0193*2 
0194*3 
0195*1 
0195*3 
0197*0 
0197*1 



i 

i 
i 



« 

i 



• 



RN0TNUM5 



INSERT: 



NASTl 



GRTl 
ORTN* 



• 



equt* 



FATlt 
FATuP* 

NGUOT: 

GETO* 
6TRT7: 



gncr; go to liP2;% 

IF PCDUP) t »Q» THEN GO To INSERT;* 

pcded;* 

pen;* 

gncr; go to ats;* 

if pcdup) * ",* then* 

BEGIN* 

pcded;* 
go to strt;% 
end;* 

i t.«« THEN G0 To N quot;% 



IF PCDUP) 
P(DEL);* 
TYP *• CCR 

gncr;* 
gncr;* 

IF PCDUP) 



i;% 



""" THEN GO TO EQUT;* 
6 THEN% 



P(XCH#64*MUL*+);« 
IF CCCR * CCR+1) X 
BEGIN* 

gncr; go to qrtn;* 
end;* 
pccaddrs^sto);* 

ADDRS * LISX;* 

IF LSTRN < THEN* 

BEGIN* 
DO GNCR UNTIL P« ''""}% 

DO GNCR UNTIL P*"*";* 
P(1)J% 

reads;*; 
eno;* 
ccr * on 

f M C R * % 

IF PCDUP) 5 «"" THEN GO To EQUT;* 

ccr ■«■ i;% 
GO to Qrt;* 
pcdel>;% 

TYP * 0}% 
IF CCR a THEN* 
BEGIN* 

gncr;* 

go to eatup;* 
end;* 
p(caddrs]>std);* 

gncr;* 

if pcdup) = »,•» then go to strt;* 

gncr; go to eati;* 

if p * «," then begin gncr; go to eatup end;* 

gncr;* 

go to nmrcl;* 

if pcdup) x "x" then go to astrx;* 

PCDEL>0)J* 

gncr;* 

if pcdup) > 7 then go to gtrt7u 

pcxch,dia 4, dib 1>trb 44);* 

gncr; go to geto;* 

if p * "»" then begin gncr; go to gtrt7 end;* 

pccaddrs]#stD);% 



00621900 


T 


0197*2 


00622000 


T 


0199*2 


00622100 


T 


0200«3 


00622200 


T 


020i»0 


00622300 


T 


020111 


00622400 


T 


0202«2 


00622500 


T 


020311 


00622600 


T 


0203*3 


00622700 


T 


0204*0 


00622800 


T 


0204«2 


00622900 


T 


0204*2 


00623000 


T 


0205*3 


00623100 


T 


0206*0 


00623200 


T 


0207*1 


00623300 


T 


0208*0 


00623400 


T 


0209*0 


00623500 


T 


0210*1 


00623600 


T 


0211*1 


00623700 


T 


0213*0 


00623800 


T 


0213*2 


00623900 


T 


0215*2 


00624000 


T 


0215*2 


01624100 


T 


0216*0 


00624200 


T 


0216*3 


00624300 


T 


0217*2 


00624400 


T 


0218*0 


00624500 


T 


0220*0 


00624600 


T 


0222*0 


00624700 


T 


0222*1 


00624800 


T 


0223*0 


00624900 


T 


0223*0 


00625000 


T 


0223*3 


00625100 


T 


0225*0 


00625200 


T 


0226*1 


00625300 


T 


0227*0 


00625400 


T 


0227*2 


00625500 


T 


0227*3 


00625600 


T 


0228*2 


Q0625700 


T 


0229*1 


00625800 


T 


0229*3 


00625900 


T 


023110 


00626000 


T 


0231*2 


00626100 


T 


023l?2 


00626200 


T 


0232*0 


00626300 


T 


0233*0 


00626400 


T 


0234*1 


00626500 


T 


0235*2 


00626600 


T 


0238*2 


00626700 


T 


0240*0 


00626800 


T 


0240*2 


00626900 


T 


0241*3 


00627000 


T 


0242H 


00627100 


T 


0243*0 


00627200 


T 


0244*1 


00627300 


T 


0245*1 


00627400 


T 


0246*2 


00627500 


T 


0249*2 



t 



1 



« 

,smi ""sKI 1 then * o s«"«°o T T oils;? 

bLGIN * 00627800 T 025111 1 

li iy l % 00627900 T 025m 

C Mn.* 00628000 T 0252*0 

tN 0'* 00628100 T 025u*0 M 

CHKOCT: IF P(DUP) * •/" THEN GO T D GETCOMAJ* 00628200 T 0253*0 * 

,,; DEL i;C 00628300 T 0254*1 

. .J' 1 00628400 T 025412 | 

rn ?n Nuori t« 00628500 T 0255*1 

GO TO NMRCL;* 00628600 T 0256*0 

$ SET OMIT * NOTCTIMESHARING) 00628650 T 025AI9 M 

GETCOVA. ESIG <- (F IBC4 ] , C 8 14 ]«10 ) ; % TRUE IF REMOTE INPUT 00628700 T 0256*2 

$ SET OMIT = TIMESHARING 00628701 T 0?S*!o 

GETC1? llrl** rn"rS?rSf SIG AN ° WT = 0) ™ EN G ° STRT ELSE 006i87 5 6 T ollhl f 

cSssjJt st°art et of ; inp UT intu ssssssss t t o^; 2 2 

STARTII P(LSTRN,0,0);% OoUSoOO T "SHI 

IF FILX, [181153 > 1 THEN* 00629100 T 026 3 *3 

BEGIN P(FILX[NOT ?]);% 00629200 T 026*80 

FILXtNOT Al^EOFLJ FlLXCNOT 33«-PARL; 00629300 T 026613 tt 

Jr r?If^ IB E^i! 2 !^ Iul N P < MKS ' M REA0NG«,FaX,7, SELECT) ; 00629330 T 027 *1 

IF . FISIO], C27533 * 2 THEN 00629340 T 0273M 

IF FlBC5],C43i23X((ACT<0)+2) THEN* 00629400 T 0276H tt 

POUSH(MKS,OKADR»CACT<0> + 2,FRX, 1 , SELECT ) i % 00629500 T 0277»3 

COMMENT CALL SELECT IF NOT REAO STATUS OR* 00629600 T 0280*3 

• GDIRECTIONH 00629700 T 0280*3 tt 

Vtoa-x P < 0) '* 00629800 T 0280*3 

c B ' 00629900 T 0283*1 

COMMENT CHECK FOR TYPE OF READ STATMENT.J* 00630000 T 0284*0 tt 

CTS ACT*A8SCJUNK1«.ACT);X 00630100 T 028/110 

IF ARRY / THEN GO TO CTB; C0MM£NT<LIST PART>NOT EMPTY; 00630200 T 0285*3 

IF FRMT i THEN GO TO CTA; COMMENT <LIST PART>»EMPTY*% 00630300 T 0287*1 tt 

<FORMAT PART> IS NOT;* 00630400 T 0288*3 

COMMENT BOTH <LIST PART> & <FORMAT PART> WAS EMPTY;* 00630500 T 0288*3 

PCI); COMMENT SET FLAG » EXIT/* 00630600 T 0288*3 tt 

READS; COMMENT RELEASE BUFFER** 00630700 T 0289*0 

CTAs LSTRN «■ -U COMMENT<LIST PART> » EMPTY;* 00630800 T 0290*0 

GO TO FMOUT; COMMENT READ IS <FORMAT>, <EMPTY>; * 00630900 T 029110 

CTB: IF NOT PCARRY * TOP* XCH* DEL) THEN GO TO CTC** 00631000 T Q29H2 

COMMENT IF LIST IS NOT A DESCRIPTOR WE HAVE* 00631100 T 0293*1 

A SPACE STATEMENT AND ACT ■ I OF* 00631200 T 0293IJ 

RECORDS TO SPACE;* 00631300 T 0293H 

IF FIB[43.[8?43«4 THEN* 00631400 T 0293*1 

BEGIN IF FIBC4], [27133X1 THEN* 00631500 T 029413 

PCMKS, FlB[7]+JuNKl#l, FILX, 1, SELECT);* 00631600 1 0296*3 

END ELSE* 00631700 T 029912 

WHILE CACT«-ACT-1)>Q D 0* 00631800 T 0299*2 

BEGIN CKPB; POLISH(MKS,DKADR,0,FlLX*ALGOLREAD); END* 00631900 T 0302*2 

LSTRN <• TLSTRN;* 00632000 T 030513 

PULISH(XIT);* 00632100 T 0306*2 

CTCJ IF NOT P( FRMT, TOP) THEN GO TO FMOUTA; COMMENT WE HAVE* 00632200 T 0306*3 

<F0RMAT>,<LIST>;* 00632300 T 030fl*0 

IF P * THEN GO TO AEXPL; COMMENT WE HAVE AEXP,At*];* 00632400 T 0308*0 

IF FI*1 THEN 60 TO FREFLD ELSE *** / TYPE FREE-FIELD READ, 00632500 T 030910 

IF V lll THEN G0 FM °UTM1 ELSE *** // TYPE FREE-FIELD READ, 00632510 T 0309*3 

IF ARRY > THEN GO TD AExPL;* 00632600 T 031110 

* m * » * » _ 






ASLST: pco 
BS: PCD'JP*CL 

IF 



COMMENT WE 
*,LSTRN*SND> 

isxd; cqmme 

lstRn < o th 
if pcxch*b 

THEN 60 TO 



• 



BR J PCI 
REA 
COMMENT 

AEXPU IF 
IF 
PCD 



ISAs 



ISBl 



IF 
PCD 



BSI 
STR 



); 

OS; 

AEXP* 

PCARR 

AEXP 

EL*AE 

COM 
PCDUP 
EL'BS 

COM 

ZE * 

COM 
EAMCP 

BEG 



COMME 
COMME 

ac*];x 

Y.C8U0 

< THE 

xp);x 

MENT ST 
) S BSI 

l2Z)i% 
MENT S 
ARRAY 
P*X 

MENT BS 
U «■ *f?i 

Pi ♦ 
IN% 

Sl<-P4 
P2CDS 



ERROR' 

COMMENT 

fmouta: pcd 
fmoutmis lst 

FMOUTS P(0 

ADD 
SAV 
CSI 

IF 



S2» 
Si I 
SJ 



LFPAR: 



GO 
PCO 
FI* 
COO 
IF 
GO 
GO 
GO 
GO 
GO 
GO 
COMMENT 
IF 
BEG 



end;* 
pcd; 

READS 
WE HAVE 

EL> I 

RN*0 ; 

*0*0*0* 

COMME 

RS ♦ LI 

EBUFF*B 

ZE ♦ BS 

FRMT=0 

BEGIN 

GO TO 

TO S }% 

EL) ; 
fi + i; 

E * O&C 
FAW > 

TO PCCO 
RTPA 
STRN 
LFPA 
SLAS 
SCAL 
LEFT PA 
FAW. [12 
IN IF P 
BEGI 



DS* P 
C 



i% 



FOR 



0*0*0 
NT 19 

sx;x 

UFF*P 

IZE x 

THEN 

COOE 
PHRA 



HAVE **LIST**X 
; COMMENT LSTRN * 0. S 

NT S ■ ADDRESS OF LIST IT 

5-1 ■ INDEX FOR BUFF; 
EN GO TO BR; COMMENT LIST 
UFF'XCH*STo*l*ADD*DUP) < 
BS; COMMENT BUFFER ITEM 
IS < BUFFER SIZE THE 
NT SET FLAG ■ EXIT;* 
NT RELEASE BUFFER;* 

3*0UP) < AEXP THEN GO TO 
N ARRY[-13«.0j 

ACK IS SMALLEST OF ARRAY 
ZE THEN GO TO ISBIX 

TACK NOW HaS SMALLEST OF 

size;* 
ize s # of words to trans 

LX*P3 ♦ BSiZE*P2 ♦ BSIZE 
CARRYCO]]);% 

♦ 32 wqs;% 
DS*32 WDS);X 

3 wds;% 

OMMENT ON ERROR* RELEASE 
MAT'LIST OR FORMAT*<EMPTY 



♦ i * on 

EM 

is exausted;* 

BSIZE 

TO LIST, IF I + 1X 

N GET NEXT WORD;* 



isa;x 



SIZE OR AEXP;* 



BUFFER SIZE*AEXP* 



fer;x 

DIV 64,% 



BUFFER AND EXIT;* 



*o*o*o*o*o*o*o*o*o*o*o*0) ; 

GOOSE EGGS FOR YE OLDE STACK l 



TO 
TO 
TO 
TO 
TO 



FAW * 

THEN 

DE>;* 

r;x 
g ; % 

R;X 

h;x 
e;x 
renth 

*ll T 

clist 

N PCD 



CO* C8UFF3*0*INX) ; 

a;x 

XXX SPECIAL // TYPE OF FR 
♦'11 J UFREEFlELD*i; FAW*U 
S END ELSE 



COMMENT LOOK AT NEXT 
FRMTCFl]>t««»2Mm 
GO TO PHRaS; COMMENT PHR 



EE-FIELD READ. 
H27U7I1] ; 



EDITING PHRASEU 

as if Sso;x 



esis;x 

HEN 

ELEMENT*DUP)<0 THEN 

EL)> FI*FAW#C28H0]+FI EN 



d; 



00632700 
00632800 

00632900 
00633000 
00633200 
00633300 
00633400 
00633500 
00633600 
00633700 
00633800 
00633900 
0063400Q 
00634100 
00634200 
00634300 
00634400 
00634500 
00634600 
00634700 
00634800 
00634900 
00635000 
00635100 
00635200 
00635300 
00635400 
00635500 
00635600 
00635700 
00635800 
00635900 
00636000 
00636100 
00636200 
00636300 
00636400 
00636500 
00636600 
00636610 
00636620 
00636630 
00636700 

0@636710 
00636800 

00636900 
00637000 
00637100 
00637200 
00637300 
00637400 
00637500 
00637600 
00637700 
00637800 
00637900 
00638000 



T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0313*0 
0313*0 

03l3t3 

0314*1 
031411 
0315*2 
0317*1 
0318*1 
0318*1 
0318*2 
0320*0 
0320*0 
0322*1 
0325*0 
0325*2 
325*2 
032613 
032711 
0327*1 
327*1 
0327*3 
0327*3 
0329*2 
0330*1 
0330*1 
0330*2 
033111 

0331*3 
0332*1 
0332*2 
0333*1 
0334*0 
0334*0 
0334*1 
0335*0 
0339*3 
0339*3 
0340*2 
0342*2 
0343*3 
0344*3 
0349*2 
0350*0 
0350*0 
0350*1 

035j*3 
0354 * 1 
0355*2 
0356*0 
0356*2 
0357*0 
0357*2 
0358*0 
0358*2 
0358*2 
0359*1 
0361*3 



# 



END ELSE PCFAW, [38*103); 
rn to s i s % 
comment right parenthesis) 3! 
rtpars if pc1»sub#dup> *0* 

then begin comment lfpar repeat --l** 

p(del); comment delete repeats 
go to si; comment pick up next phrase** 
end;* 

cfaw and 1023); comment set fi back to lfpar;* 



# 



FI 

GO 

COMMENT 



«■ FI - 

to Si; 

SCALE 



factor;* 



SCAlEJ 



SCFTR*IF FAW. [12:13 



GO 
COMMENT 



STRNGJ 



IF 



TO Si;i 

strings;* 

(CHR <• (W * 
THEN GO TO 



THEN LlSTELEMENT 

ELSE 04FAHC38I38U0J4FAWC1IH 



13; 



faw,[6$63) + chr)>csize* 
error; comment buffer overflow;* 
comment chr * chr + h*% 



STREAM(P2 * W»P1 «• 0$P0 ♦• BUFF)** 
BEGIN* 

si*po;% 
di*loc pi;* 

DI«-DI*P2;* 
DS«-P2 CHR;* 

END,** 

BUFF <> p;* 

FRMTCFI] <- P(XCH)&FAWC1 



1:113; 
STRING 08TAINED FROM 



COMMENT DIAL S,CQDE & W TO 
BUFFER AND PUT RESULT* 



PHRAS: 



BACK INTO FORMAT ARRAY;* 
GO TO S\$Z 

COMMENT SLASH;* 
SLASH! P0LISH((LSTRN<0) AND FAW);* 

READS; COMMENT RELEASE BUFFER;* 

chr «-o;* 

BUFF «■ PCO»tBUFF]»0»lNX)j» 
CSIZE ♦ BSIZE x 8;* 
GO TO si;* 
COMMENT BREAK APART FORMAT WORD;* 

FAW.C12I13 THEN PC LI STELEMENT ) ELSE PC FAWf [ 38 * 10 3 ) ; 



IF 
IF 



C0DEsl3 THEN 



CQDE*IF 
IF 
IF 

IF 
IF 
IF 
IF 
IF 
IF 
IF 
IF 



(C0DE<-LISTELEMENT) = W D* THEN ELSE 



CODE* M T» 
CODEs w X" 
CODE*"A" 
CODE»"I" 

CODE* M F M 



THEN 1 

THEN 2 

THEN 4 

THEN 6 

THEN 8 
CODEs"E"THEN 10 

CODE^U" THEN 11 



CODE""0" 

CoDE»"L" 
C0DE="R" 



CODEl«-CoDE=i ; 

IF CTYP*CODE*H) AND 

W*IF FAW. 1 131 13 THEN 

IF TYP AND FAW f [27!l3 
ELSE FAW.[6:63 ; 
D*IF FAw,C14*13 THEN LlSTELEMENT 



THEN 
THEN 
THEN 



12 

14 

15 



ELSE 
ELSE 

ELSE 
ELSE 
ELSE 
ELSE 
ELSE 
ELSE 
ELSE 
ELSE 



16. 



FAW. [31*13 THEN GO TO FMTERR ELSE 
LISTELEMENT'CODEI ELSE 

then 64 



00638100 
00638200 
00638300 
00638400 
00638500 
00638600 
00638700 
00638800 
00638900 
00639000 
00639100 

00639200 
00639300 
00639400 
00639500 
00639600 
00639700 
00639800 
00639900 
00640000 
00640100 
00640200 
00640300 
00640400 
00640500 
00640600 
00640700 
00640800 
00640900 
00641000 
00641100 
00641200 
00641300 
00641400 
00641500 
00641600 
00641700 
00641800 
00641900 
00642000 
00642100 
00642150 
00642200 
00642300 
00642400 
00642500 
00642600 
00642610 
00642700 
00642800 
00642900 
00642905 
00642910 
00643000 
00643010 
00643020 
00643100 



0364«2 
036583 
0366*1 
0366*1 
0367*1 
0368*0 
0368*1 
0368*3 
036813 

0370*3 
037i li 

0371*1 

0373*1 
0377*1 
0377*3 
377*3 
0380*0 
0381*0 
0381*0 
0382*2 
0382*2 

038?*3 
0383*0 
0383*2 
0384*0 
0384*1 
0384*2 
0385*0 
0387*1 
0387*1 
0387*1 
0387*3 
0387*3 
0389*0 
0390*0 
0390*3 
0392*1 
0393*2 
0394*0 
0394*0 
0397*1 
0401*3 
0404H 
0406*1 
0408*1 
0410*1 
0412*1 
0414*1 
0416*1 
0418*1 
0420*1 
0423*0 
0424*1 
0426*2 
0431*0 
0432*1 
0434*3 



• 
• 






IF P(QUP)SO 
IF W<0 THEN 
ELSE 
IF 0<0 THEN 
THEN GO TO 



ELSE IF TYP THEN FAW. [32*63 

ELSE CD1«-FAW, [20S43)-KD2«-FAW.C16*43); 

THEN 60 TO S2 ; 

IF C0DE1 AND W»(-l) THEN GO S2 

IF NOTCCOOE'O OR C0DE=12> THEN GO TO FMTERR; 

IF N0TCC00EX15 AND CODE/8 AND C0DEX10) 

fmterr > 



IF W=0 THEN IF C0DEX2 AND NOT CODE! THEN GO S2 ; 

IF TYP THEN BEGIN IF D>63 THEN D*63 } 

IF N0T(FAW t [27»13 OR W<64) THEN 
ELSE W*W, [42*63 * GO TO INLOQP 

IF FAW, [13*23*0 OR FAW , [2 } 43*1 3 THEN 

BEGIN Gq TO PCIF CQD£=15 T*EN 8 ELSE IF CODEl 
ELSE CODE) ; 

go c; go x; go a; go i; go r; go e; go o; 

GO TO FMTERR / 
L» W1«-IF WS5 THEN W ELSE 5; GD TO Z; 
X* Wl«-W DIV 641 W<-SKlP«,W,t42S63; 



GO TO FMTERR 

END ELSE 

THEN 2 



GO I* 



GO TO ZH2 J 
A! W1*IF WS6 THEN W ELSE 6; 
Zi SKIP*W-W1J 60 TO ZW2? 
IS H1*IF W<8 THEN H ELSE 8/ 

SKIP<-IF W<16 THEN ELSE W~16j 

w2*w-skip»wi; go to zo; 

E: D*(FAW, [2143*13 OR fAW , C 14 $ 1 J )+0> 
02«-D-Di*IF D<8 THEN D ELSE 8; 
SkIP*IF £W-D)<5 THEN ELSE W-D-5* 

wi«.W2*o; go To swt; 

RJ 02*D*D1<-IF DS8 THEN D ELSE 6} 

SKIF«-IF (W-D3S17 THEN ELSE W-DM7; 

W1MF (W-D3S8 THEN W-D-l ELSE 8j 

W2*-IF (W-D-SKIP)<9 THEN ELSE H-D-SKlP-9; 

GO to swt; 

CI 0: H+8J Wl*SKlP*Oi 
ZW2* W2«-0; 
ZD: 0*di«.D2*0J 
SWT; WT*.Wl + W2l 
END ELSE 

BEGIN WT<-(W1«-FAW.C28S43) + {W2*FAW, £2454 3)1 
SKIP«-FAW, [32:63; 

end; 
inloop? if code < 2 then go to fldwjx 

if lstrn>0 then if c0de»1] then go to utype else go flow 
ELSE ualldone ; 
flow: if codei then begin buff*savebuff; chr*w; go xtype end ; 
if (chr«-w + chr)>csize 

then go to error; comment buffer exausted;* 
comment select editing phrase;* 
jmp: if code » 15 then go to rtype;* 
code then go to fmterr ; 



IF 

IF 
GO 
GO 

GO 
GO 
GO 
GO 
GO 



TO 
TO 

TO 
TO 
TO 

TO 
TO 



P(CODE);% 

otype; 

xtype; 

alfa; 

Itype; 
ftype; 
etype; 



COMMENT 
COMMENT 
COMMENT 
COMMENT 
COMMENT 
COMMENT 



CODE 
CODE 
CODE 
CODE 
CODE 
CODE 




2 
4 
6 
8 



=d;% 
*x;% 
«a;% 
■ U% 

=f;« 



» io»e;% 



00643110 
00643200 


T 


0436*3 


T 


0438*1 


00643300 


T 


0442*3 


00643320 


T 


044450 


00643330 


T 


0446*3 


00643340 


T 


0449*3 


00643350 


T 


0453*1 


00643360 


T 


0454*1 


00643370 


T 


0457*3 


00643372 


T 


0460*2 


00643376 


T 


0462*2 


00643400 


T 


0464*2 


00643500 


T 


0467*3 


00643590 


T 


0470*2 


00643600 


T 


0472*1 


00643700 


T 


0476*1 


00643800 


T 


0476*3 


00643900 


T 


0480*0 


00644000 


T 


0483*0 


00644100 


T 


0483*2 


00644200 


T 


0486*1 


00644300 


T 


0488*0 


00644400 


T 


0490*3 


00644500 


T 


0494*0 


00644600 


T 


0496*1 


00644700 


T 


0499*2 


00644800 


T 


0503*1 


00644900 


T 


0507*2 


00645000 


T 


0509*1 


00645100 


T 


0513*0 


00645200 


T 


0517*1 


00645300 


T 


0521*2 


00645400 


T 


0526*3 


00645500 


T 


0527*1 


00645600 


T 


0529*1 


00645700 


T 


0530*0 


00645800 


T 


0531*3 


00645900 


T 


0533*0 


00646000 


T 


0533*0 


00646100 


T 


0536*3 


00646200 


T 


0538*0 


00646300 


T 


0538*0 


00646400 


T 


0539*1 


00646500 


T 


0542*1 


00646600 


T 


0542*1 


00646700 


T 


0545*0 


00646800 


T 


0546*1 


00646900 


T 


0547*1 


00647000 


T 


0547* 1 


00647020 


T 


0548*2 


00647100 


T 


0549*2 


00647200 


T 


0550*0 


00647300 


T 


0550*2 


00647400 


T 


0551*0 


00647500 


T 


0551*2 


00647600 


T 


0552*0 


00647700 


T 


0552*2 



# 



FMTERRS 
UE*R* 



GO 
GO 

IF 



TO 
TO 



otype; 
logi ; 



COMMENT 
COMMENT 



CODE 
CODE 



« 12*01% 

■ 14*l;% 



FILX t [18U53>l THEN 

BEGIN %%% NOT -ARRAYROWBUFF* SO TRY PAR LBL 
PCFILXtNOT 3]); FILXtNOT 33«-FlLXCNOT 43*0 
P(MKS*9*JUNK) ; 

end ; 

TEN4-0; TEN«.P(rTENU 33/CFX>SFB)U0C8*38?103 i 
W2*C(WUriB[7] + l)>9) + (Wl>99>+(Hl>999) + i i 
IF NOT UTYP THEN 
BEGIN ; 
STREAM(P2«-W2/Pl«-W1*TEN) ; 

BEGIN DS*-14LIT*'-FMT ERR* REC«"»; 
DS«-P2 DEC; DS«-lOLIT"# NO LBL»* n 
END ; 



BRANCH, 
i 



SI*LOC 

; 



pi 



END 



ELSE 



BEGIN ; 

STREAM(P9*W2*P8*(CHR>9)+CCHR>99)*1#P7*UEXP*UH#CHR» 
W1kP6*D*UD*P5«.0X0#P4«'(D>9) + 1*P3«-W*UW*P2*W^0# 
Pl*CW>9)+i,P0*CHR*UFREEF!EUD*TEN) i 
BEGIN 0S*2LIT"-U"; P2CSI*LQC P3) OS*Pj DEC) ; 
P5CDS4.LIT«,»1 Sl*-LQC P6; DS*P4 DEC ) ;P0< DI*DI*5 5 1 
DS«-51IT« ERR*"; SI*U0C 97 i DS*DEC ', 
0S«-5LIT">CHRs"; SI*SI+TJ DS*CHR ; 
DS^LIT^COL*"; DS«-P8 DEC; DS«.3LIT",R« H ; 
0S«-P9 DEC; DS«-9LIT"#N0 LBL** H * 
END ; 
IF CHR THEN STREAMCTeN); DS*7LIT w «FREFLD" I 
END ; 
PCCTENCOJ3.C33»153*3«#COM) ; 



COMMENT L PHRASE!* 
LOGH STREAMCP3 

BEGIN* 

Sl«-P2;% 

si+si+pi; 

oi*uoc pi;* 
qs<-6 lit "true 
di*-di-6;% 

IF P3 SC / QC% 

THEN GO TO Bl 
LA; TALLY <- J ; 

GO TO LCU 
BLi DULOC PI ; 

OS* 6 LIT •» TRUE 
DI*DI-6;« 

sr*si*P3;% 

IF P3 SC*DC% 
THEN TALLY<-i; 

LC! P3 *■ tally;% 
P2 «• si;x 



♦ Wl, P2 «- BUFFSP1 «- SKIPJJX 



COMMENT SKIP ANY LEADING BLANKS; 
"; COMMENT PUT COMPARE IN PiJ% 



COMMENT IF SAME*P3*W% 



»«; COMMENT PUT COMPARE IN ?X',% 



COMMENT IF SAME* P3-U% 



GO 
COMMENT 
DTYPES 



end;;* 
TO coma;% 
d phrase; % 
streamcp2 

BEGINJS 



«■ 0* PI <• BUFF);* 



00647800 
00647900 
00647903 
00647906 
00647909 
00647912 
00647915 
00647918 
00647921 
00647924 
00147927 
00647930 

00647933 

00647936 

00647939 

00647942 

00647945 

00647948 

00647951 

00647954 

00647957 

00647960 

00647963 

00647966 

00647969 

00647972 

00647975 

00647978 

00647981 

00647984 

00647987 

00647990 

00648000 

00648100 

00648200 

00648300 

00648400 

00648500 

00648600 

00648700 

00648800 

00648900 

00649000 

00649100 

00649200 

00649300 

00649400 

00649500 

00649600 

00649700 

00649800 

00649900 

00650000 

00650100 

00650200 

00650300 

00650400 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0553 5 
0553 5 2 
0554*0 
055410 
0555*1 
0555*3 
0560*1 
0561*0 
0561*0 
0564*1 

0569*1 
0570*i 

0570*3 
0572*1 
0574*2 
0576*2 
0576*3 
0576*3 
0576*3 
0577*1 
0580*3 

0586*1 

0589*2 

0591*2 

0594*2 

0596*0 

0597*2 

0599* 3 

0601*3 

0602*0 

0605*1 

0605* 1 

0606*3 

0606*3 

0608*1 

0608*1 

0608*2 

0609*0 

0609*1 

0610*1 

0610*2 

0611*0 

0611*2 

0611*3 

0612*0 

0612*1 

0613*1 

0613S2 

0614*0 

0614*2 

0615*0 

0615*1 

0615*2 

0615*3 

0616*1 

0616*1 

0617*2 



• 
• 



CO 
OTYPES 



si«-pi;x 

Sl«-Sl+8/% 

P2*sn% 

BUFF * Pt% 

go to comm;% 
mment phrase1x 



STR 
8EG 



END 

IF 

8EG 



EAM(P2*0: P1*BUFF); % CHECK FOR FLAG BIT 
IN 

SI 

IF 



END 
COM 

STR 
BEG 



END 
BUF 
GO 



P2 

P THE 

IN 
COM 
SIM 
IF 
IF 

* 
* 

MENT 

EAMCP 

IN 

SI 

DS 

P3 

F «■ P 
TO CO 



* pi; 

sb then tally * 1; 

«• tally; 



N 

X DATA HAS 

MENT IF F-FIELD ■ 
PIE VARIABLE IN ST 
CJUNK1 * CADORS3 • C 
PC10>L0D).tl8*153 

EITHER NO FLAG BIT 
3«-Os P2*BUFF# Pl«-[ 



FLAG BIT 

OR R THEN LIST ITEM 1$ 

ACK OR prt; 

181153) ■ THEN GO FLAGBIT; 

* JUNK1 THEN GO FLAGBIT; 

OR DATA GOES TO ARRAY; 
ADDRS3); 



*■ P2t % DI SET FROM LAST PARAMETER 

«- a chr; 

* Si; 



MM } 



FLAGBIT: 






CO 

UTYREJ 



COM 
BAD 
JUN 

PCJ 
COM 

MMENT 
IF 
SGN 
W*I 
UBU 
DO 

use 

IF 

UNL 

IF 



MENT FL 

PROBLE 

Kl <- [J 

unkij; 

MENT CO 
U PHRAS 
D>CSIZE 
«-SGN&12 
F w=o T 
ILD*UCH 
UCH UNT 
HCNT*UB 
UDELIMC 

OCA-TED* 
UH="%» 

BEGIN 

uch; 

UN(JM«- 
WHILE 

IF UB 



AGGED DATA GOING 
MS, FORCE FLAG B 
UNK13; 



TO STACK OR 
IT INTERRUPT 



PRT CAN 

here; 



CAUSE 



GO TO 
END ; 



NTROL 

e;% 

THEN U 
U2I42! 
HEN TEN 
CNT<-0 ; 
IL UEOW 

UILDM 

HK THEN 
UNUM*UV 
THEN XX 
%% 
S6N*S6N 
UH<8 ; 

(UBUIL 
BEGIN U 

UILD=17 
BEGIN % 
UVAL*UH 
END ; 
UENDNU 



CANNOT REACH THIS POINT; 



ALLDONE ; 
6UDC36I4 
C6Q3 ELSE 



%%* EXIT IF M1N FLD-WDTH>BUFFSZ 
2»63&Wt30:a2*63 ; 
IF W>CSIZE THEN CSIZE ELSE W + 1J 



OR UHX" M ; %%% SCAN UNTIL CST OR E*Q-W 



GO TO UL 
AL«-UDEC«-U 
X WE MAY 
% GTR 377 

EQV (NOT 

D*UBUILD+ 
VAL*UH&UV 
AND UH<8 
%% WE NOW 
&UVALLH4 

m ; 



5 ; ubuff<-uh ; 
exp*0; usgn<-ugetsgn ; 
have an octal numj error exit if 
7777777777777 or has digit gtr 7 
ugetsgn) j x%xusgn*usgn+ugetsgn 

1X17 AND UH<8 00 

ALC3«6J423; UCH END ; 
AND (NOT UVAL.C3U3) THEN 
BUILD 16-TH OCTAL DIGIT, 

S443; UCH ; 



00650500 
00650600 
00650700 
00650800 
09650900 

00651000 
0065H00 
00651200 
00651210 
00651220 
00651230 
00651240 
00651250 
00651300 
00651310 
00651320 
00651330 
00651340 
00651350 
00651400 
00651410 
00651420 
00651430 
00651440 
00651450 
00651500 
00651510 
00651520 
00651530 
00651540 
00651550 
00651600 
00651610 
00651620 
00651630 
00651640 
00651715 
00651720 
00651725 
00651730 
00651735 
00651740 
00651745 
00651750 
00651755 
00651760 
00651765 
00651770 
00651775 
00651780 
00651785 
00651790 
00651795 
00651800 
00651805 
00651810 
00651815 



T 
T 
T 
T 

T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0617*2 
0617*3 
0618*0 

0618*1 
0618*2 
0619*0 
0619*2 
0619*2 
0619*2 
0620*3 
062013 
0621*0 
0621*3 
0622*0 
0622*1 
0622*1 
0622*3 
0622*3 
0622*3 
0625*1 
0627*1 
0627*1 
0627*1 
0628*3 
0628*3 
0629*0 
0629*1 
0629*2 
0629*3 
0630*1 
0630*3 
0630*3 
0630*3 
0630*3 
0631*2 
0631*3 
0631*3 
0631*3 
0633*0 
0636*3 
0641*2 

0643*2 
0647*1 
0648*2 
0651*2 
0658*1 
0659*0 
0659*2 
0663*0 
0664*1 
0667*2 
0672*0 
0675*0 

0675*2 
0678*0 
0678*0 
0678*2 






IF 



UENqNUM: IF 



UNUM«-UH<10 i 

WHILE UH<10 00 BEGIN UVAL*10xUVAL+UH; UCH END ; 
IF UHs"," THEN 
BEGIN 

uch; unum*unum or uh<io ; 
while uh<10 do 

begin ubuild«-ubulld+i; udec «-10x|jdec + uh ; uch end; 

> 

" or uh="e" then 

in ubuild*-ubuild; uch; uexpsgn«-ugetsgn ; 

NOT UNUM THEN UVAt_*l > 
UH<10 THEN 

begin unum«-i; ubuilo*-ubuilo ; 

DO BEGIN UEXP*iOXUEXP+UH; uch end until uh>9 ; 

end ; 

t 

then %%% the cst has enough characters to unambig- 

in %%% uously appear as a number. 

ubuild<0 then u600fe0c5) ; 

l*uval+udec/ten[ubuild-i3 ; 

uexp/o then uval<-p(uval>ten[uexp3>if uexpsgn then 

PC/) ELSE P(x)) ; 

F SGN THEN -UVAL ELSE UVAL> EADDRS3 * STD) i 

* UCHECKIT ; 

* 

9 



END 
UH<b*P 

BEG 

IF 

IF 



END 
UNUM 

BEG 
IF 
UVA 
IF 



UBUI 
IF U 

ELSE 
IF N 

IF C 
00 I 
UNTI 
P(UB 
UL6: 
IF L 

USCH 
COMMENT A 



ALFA* 



P<I 

UL5 

END 

LD*0 

IF 

BEG 
QTCU 

BEG 
UVAL 
F CU 
L UV 
UFF, 

IF 

STRN 

BEG 

CNT* 

PHR 

S 

BEG 



COMMENT 
XTYpE! 



END 

GO TO CO 

PHRASE A 

IF CCHR* 

THEN Go 

S 

BEG 



" THEN 
UDELIMCHK 

IN U8UFF* 

DEC*USDEL 
IN UL4* U 
*0)*USCHC 
VAL* w x"&U 
AL. [2**13 
[ADDRS3,S 

UDEC THE 
<0 THEN 
IN DO UCH 

ubuff*o; 
ASE ; 
TREAMCP3* 
INX 

si*p2;x 

SI4-SI+P 

Dl*LOC 

DK-DI-P 

DS*P3 C 

P2*si;% 
i% 

ma;% 

ND T PHRA 
CHR+W*x64 
TO ERROR 
TREAMCP3* 
INX 

Sl*P3;X 
SI*SI+P 



THEN U8uFF«-UBUFF f [12*303 ELSE GO TO UL3 

uschcnt«-o; uqstrng*uexp«-i; ul3* uch end * 
imchk) and uschcnt<6 then 
buffit; go to ul3 end ; 
nt then go to ul6 ; 
vale24$30*183)=ubuff then qo to ul6 

TD) ; 

n go to ul5; if lstrn>0 then addrs*lisx; 

until usdelimchk; go to ul5 end ; 
go to ul4 ; 

Wi*P2*BUFF*Pl«-SKIP};l 



i; COMMENT SKIP EVERYTHING BUT LAST di% 

P2;x 

hr;« 



se ; 

)>csize-c0de1 

; comment buffer exausted* 

buff«p2«-w1#p1«-w);% 



i;% 



00651820 


T 


00651825 


T 


00651830 


T 


00651835 


T 


00651840 


T 


00651845 


T 


00651850 


T 


00651855 


T 


00651860 


T 


00651865 


T 


00651870 


T 


00651875 


T 


00651880 


T 


00651885 


T 


00651890 


T 


00651895 


T 


00651900 


T 


00651905 


T 


00651910 


T 


00651915 


T 


00651920 


T 


00651925 


T 


00651930 


T 


00651935 


T 


00651940 


T 


00651945 


T 


00651950 


T 


00651955 


T 


00651960 


T 


00651965 


T 


00651970 


T 


00651975 


T 


00651980 


T 


00651985 


T 


00651990 


T 


00651995 


T 


00652000 


T 


00652005 


T 


00652010 


T 


00652015 


T 


00652100 


T 


00652200 


T 


00652300 


T 


00652400 


T 


00652500 


T 


00652600 


T 


00652700 


T 


00652800 


T 


00652900 


T 


00653000 


T 


00653100 


T 


00653200 


T 


00653300 


T 


00653400 


T 


00653500 


T 


00653600 


T 


00653700 


T 



0678*2 
0679*3 
0684*2 
0685*1 
0685*3 
0688*3 
0690*0 

0694*0 
0694*2 

0696*1 
070j,*i 
0703*0 
0703*3 
0706*0 
0710*1 
0710*1 
0710*1 
071111 
0711*3 
0714*1 
0716*3 

0719*2 
0721*2 
0724*0 
0750*3 

0750*3 
0751*2 
0752*1 
0755*3 
0761*0 
0763*3 
0765*2 
0767*1 
0769*2 
0771*1 

0772*0 
0774 ? 1 
0775*3 
0779*0 
0780*3 
0780*3 

0782*1 
0782*1 

0782*2 
0783*0 
0783*1 
0783*3 
0784*1 
0784*2 
0784*3 

0785*1 
0785*1 
0787*1 
0788*2 
0790*0 
0790*0 
0790*1 



• 
• 
t 



* 

m 



si 



P2CSl*Sl+32;* 
Sl*Sl+32);% 

P3*SII% 

end;* 

RUFF > PJ* 

go to comm;* 

COMMENT I PHRASE;* 
ITYPE* PC03J COMMENT RLlT m FROM 

FIN: COMMENT FIRST WE GET SIGN AND 

STREAMC* 



I (SEE FOUT>;% 

COUNT LEADING BLANKS;? 



NTBLK5 



P4*WT, COMMENT IN^FIELO W IDTH, OUT*LEADING* 

BLANKS;* 
P3«-0 p COMMENT PLACE TO RETURN SIGN;* 

p2+buffs comment in and out*buffer address;* 
p1«-skip);c0mment # of leading characters to* 

ignore;* 

BEGIN* 

Si*P2;* 
si«-si+pi;* 
p4uf sc*" " then* 
jump real to ntblku 
si*si+u* 
tally*tally+1);% 
comment if 

WHOLE 
Pft*TALLY'* 

GO TO iexit;* 

IF SC<"0" THEN* 

BEGIN COMMENT SIGN IS PRESENT;* 



WE FALL THROUGH LOOP THEN* 
FIELD WAS BLANK;* 



.«.»« 



then; 



IF SC 

si*si+i; 
tally*tally+i;* 
end;* 
impls: p4«-tally; comment 
tally*0; comment 
if toggle* 

then tally«-i; comment 
p3*tally; comment 
p2*sii comment 



COMMENT 
COMMENT 



toggle* true?* 
skip sign;* 



leading blanks*"Sign«;* 
indicate + sign;* 

toggle * true if "-";* 
pass back sign;* 

ADDRESS OF FIRST DIGIT;* 






iexit; 

end;* 
buff «• p;* 
sgn «■ p;x 

COMMENT NOW TO CONVERT INTEGER;* 
STREAMC* 

p5 *(p(ssn#wt>+,dup))>* 

pa «• (if p < 8 then 0* 

else pc8* - »8»xch))** 

comment if wt-'»leading blanks" > 8* 
then p5«-wt-leadlng blanks>p4* 0* 
else p5«-8,p4«-wt«lea0ing blanks-8;* 

p3*0, comment place to return low half;* 

p2«-o#comment place to return high half;* 

puoi po <- buff);* 

BEGIN* 

si«-po;* 

DK-LOC P2}% 

DS«-P4 OCT; COMMENT CONVERT HIGH HALF;* 



00653800 


T 


0790*3 


00653900 


T 


079112 


00654000 


T 


079210 


00654100 


T 


0792»1 


00654200 


T 


079212 


00654300 


T 


079310 


00654400 


T 


0793*2 


00654500 


T 


079382 


00654600 


T 


0793*3 


00654700 


T 


0793*3 


00654800 


T 


0794*0 


00654900 


T 


0794*1 


00655000 


T 


0794*1 


00655100 


T 


0794*2 


00655200 


T 


0795*0 


00655300 


T 


0795*2 


00655400 


T 


0795*2 


00655500 


T 


0795*2 


00655600 


T 


0795*3 


00655700 


T 


0796*1 


00655800 


T 


0797*1 


00155900 


T 


0797*3 


00656000 


T 


0798*0 


00656100 


T 


0798*2 


00656200 


T 


0798*2 


00656300 


T 


0798*2 


00656400 


T 


0798*3 


00656500 


T 


0799*0 


00656600 


T 


0799*2 


00656700 


T 


0799*2 


00656800 


T 


0800*0 


00656900 


T 


0800*1 


00657000 


T 


0800*2 


00657100 


T 


0800*2 


00657200 


T 


0800*3 


00657300 


T 


0801*0 


00657400 


T 


0801*0 


00657500 


T 


0801*2 


00657600 


T 


080i*3 


00657700 


T 


0802*0 


00657800 


T 


0802*1 


00657900 


T 


0802*3 


00658000 


T 


0803*1 


00658100 


T 


0803*1 


00658200 


T 


0803*2 


00658300 


T 


0804*2 


00658400 


T 


0805*3 


00658500 


T 


0807*1 


00658600 


T 


0807*1 


00658700 


T 


0807*1 


00658800 


T 


0807*1 


00658900 


T 


0807*2 


00659000 


T 


0807*3 


00659100 


T 


0808*3 


00659200 


T 


0808*3 


00659300 


T 


0809*0 


00659400 


T 


0809*1 






DIALOG P3J* 
DS*P5 OCT; 

pi«-si;% 

ENon 
buff ♦• p; 
p(ten8#mul»+)j 



COMMENT CONVERT LOW HALF;% 



COMMENT SAVE NEXT FIELD ADDRESS; 
COMMENT HIGH HALF x 10*8% 

+ low half;% 



IF SGN THEN PCCHS)** 

IF PCXCH#OEL#XCH#DEL»XCH»DUP) THEN PC XCH> C ADDRS] ,*■ ) 
ELSE IF PCXCH,DuP>* PCMAXI) THEN P ( t ADDRS] , ISO ) 
ELSE PUAD0RS3#*); 



% VOID 
FO 



FT 
FA 



UT : IF P THEN 

GO TO COM 

COMMENT F PHR 



YpE* 



: 



p(u;x 

GO TO FIN 
STREAMCP5 
p4 
P3 
P2 
PI 
BEGI 



* 



• 



ET 



end; 
buff ♦ p;x 

PCTENCD2] x p + 
P((ABS<ADDRS)x 
P(TENC03»/>; 
IF SGN THEN PC 
P([ADDR5J#STD); 
P(DEL*DEL) 3% 
GO TO comm;% 
COMMENT E PHRASEJ* 
YPES STREAMCP6*- 0* 

P5 «■ PCD 
P4 <- C I 



go to fa;x 
m;x 

ASEII 

; comment use itype to convert integer part; 

* 02t% 
*■ QlfX 

+ * COMMENT PLACE TO RETURN LOW HALF; 

♦ , COMMENT PLACE TO RETURN HIGH HALF** 
<■ 0*P0 * BUFF) J % 

NX 

si«-po ;% 

sl«.si + i; comment skip decimal poi'ntj* 

DK-LOC P2i% 

DS*P4 OCT; COMMENT CONVERT HIGH HALFU 

DI*L0C P3;% 

DS*P5 OCT; COMMENT CONVERT LOW HALFU 

pi*si;% 
% 



P)3 COMMENT HIGH HALF x 10*02 ♦ LOW HALF; 
TENCD3) + P); COMMENT INSERT INTEGER PART; 
COMMENT SCALE TO PROPER DECIMAL PLACE; 
CHS);* 
% 



COMMENT PLACE TO RETURN EXPONENT** 
DUP)» COMMENT D2 IN*MANTISSA SIGN OUT; 
< 8 THEN P(0#,D2»SN0#XCH)X 



"1* 
F P 



COMMENT IF CD-P 



ELSE P(8»'».02#SN0»8))»% 

> 8 THEN P5= D-1-8#P4* " 
ELSE P5* Op 
ON 



P3 ♦ 

P2 

PI 

PO 

BEGI 



PCO)# 

«■ o, 

«■ BUF 
*• SKI 
H% 
SI*P1 
SI*3I 
PO*SI 
SI*SI 



FIX 

p);% 



01 * P4. 

niGiT;x 

COMMENT PLACE TO RETURN 
COMMENT PLACE TO RETURN 



8% 

P4«DM>% 

RETURN P4MNTEGER* 



low halfu 
high half;% 



+P0*% 

; COMMENT 

+2; 



ADDRESS 

COMMENT SKIP 



of integer;* 

integer digit & "."jx 



00659500 
00659600 
00659700 
00659800 
00659900 
00660000 
00660100 
00660200 
00660290 
00660300 
00660310 
00660400 
00660500 
00660600 
00660700 
00660800 
00660900 
00661000 
00661100 
00661200 
00661300 
0066140Q 
00661500 
00661600 
00661700 

00661800 
00661900 
00662000 
00662100 
00662200 
00662300 
00662400 
00662500 
00662600 
00662700 
00662800 
00662900 
00663000 
00663100 
00663200 
00663300 
00663400 
00663500 
00663600 
00663700 
00663800 
00663900 
00664000 
00664100 
00664200 
00664300 
00664400 
00664500 
00664600 
00664700 
00664800 
00664900 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 



0809 I 3 
0810»0 

0810«2 
0810*3 
0811*0 
0811*2 
0812*1 
0812*1 
0813*1 
0816*0 
0820*0 
082l*0 
0821*0 
0821*3 
0822*1 
0822*1 

0823*1 
0823*3 
0824*1 
0824*2 
0824*3 
0825*0 
0826*0 
0826*0 
0326*1 
0826*2 
0826*3 
0827*1 
0827*2 
0828*0 
0828*1 
0828*2 
0829*0 
0830*0 
0831*2 
0832*1 
0833*1 
0833*3 
0834*1 
0834*3 
0834*3 
0835*2 
0836*2 
0838*2 
0840*1 
0840*1 
0840*1 
0840*1 
0840*1 

0840*2 
0840*3 
0841*1 
0841*3 
0841*3 
0842*0 

0842*2 
0842*3 



Dl<- LOC P2'X 00665000 T 084380 

OS* P4 OCT; COMMENT CONVERT HIGH HALF;* 00665100 T 0843*1 

# DI* LQC P3U 00665200 T 0843*3 

OS* P5 OCT? COMMENT CONVERT LOW HALF;* 00665300 T 0844*0 

SK-SI + 1' COMMENT SKIP »*«}% 00665400 T 084412 

£ IF SC= M * M THEN; COMMENT IF EXPONENT < 0* 00665500 T 0844*3 

THEN TOGGLE «■ TRUE;* 00665600 T 0845*1 

SI*SI + D COMMENT SKIP EXPONENT SIGN;* 0§665700 T 0845*1 

£ 01* LOC Pen 00665800 T 0845»2 

DS* 2 OCT; COMMENT CONVERT EXPONENT;* 00665900 T 0845*3 

PI* Si; COMMENT RETURN ADDRESS OF NEXT* 00666000 T 084610 

FIELDJI 00666100 T 0846*1 

IF TOGGLE THEN* 00666200 T 0846*1 

BEGIN DI*DI-8*X 00666300 T 0846*2 

$ DS* LIT "+«;* 00666400 T 0846*3 

END; COMMENT IF TOGGLE SET EXPONENT* 00666500 T 0847«1 

NEGATIVE;* 00666600 T 0847*1 

$ SI*PO;* 00666700 T 0847*1 

DIALOG P4; COMMENT CONVERT INTEGER DIGIT;* 00666800 T 0847*2 

DS «• OCT;* 00666900 T 0847*3 

$ Sl*SI-2* COMMENT LOOK AT SIGNU 00667000 T 0848*0 

IF Sc = '»-" THEN TALLY «-t;* 00667100 T 0848*1 

P5*TALLY;* 00667200 T 0849*0 

$ END;% 00667300 T 0849*1 

COMMENT ON RETURN STACK CONTAINS* 00667400 T 0849*2 

BUFF* 00667500 T 0849*2 

# HIGH HALF* 00667600 T 0849*2 

LOW HALF* 00667700 T 0849*2 

INTEGER DIGIT* 00667800 T 0849*2 

# MANTISSA SIGN* 0B667900 T 0849*2 

EXPONENT;* 00668000 T 0849*2 

BUFF ♦ P;* 00668100 T 0849*2 

# PCTENCD2] x P + P); COMMENT HIGH HALF*10*D2+LQW HALF;* 00668200 T 0850*0 

PCXCH,TENCD-I3xp+P);C0MMENT SCALE INTEGER DIGIT D PLACES* 00668300 T 085l*0 

AND ADD FRACTION PART;* 00668400 T 0852*3 

0. IF P(XCH) THEN P(CHS); COMMENT INSERT SIGN;* 00668500 T 0852*3 

P(XCH); COMMENT EXPONENT TO TOP;* 00668600 T 0853*3 

IF (UUNK1 «• P-CO*X ) 3 2 0* 00668700 T 0854*0 

# THEN PCTENCJUNKU^MUL)* 00668800 T 0855*3 

ELSE PCTENt-JUNKll*/); COMMENT INSERT EXPONENT;* 00668900 T 0857*1 

GO TO COMBU 0«669000 T 0858*3 

COMA* BUFF <• P;* 00669100 T 0859*1 

COMB* PCCADDRSl^STD); COMMENT RESULT TO LIST;* 00669200 T 0859*3 

C0MM5 IF CODE < 2 THEN GO TO COmC; COMMENT PHRASE DIDNT USE* 00669300 T 0860*1 

ANYTHING FROM LIST;* 00669400 T 086l»2 

IF LSTRN>0 THEN ADDRS*IF NOT ULIST THEN LISX 00669500 T 086l*2 

ELSE PC.UAODRS,LOD) ; 00669505 T 0864*1 

ULIST'*0 » 00669510 T 0866*0 

COMC* IF PCCUFREEFIELO*0>*-*DUP)>0 THEN GO TO INLOOP ; 00669600 T 0867*3 

PCDEL?;* 00669700 T 0870*2 

GO TO Si;* 00669800 T 0870*3 

COMMENT THE <REPEAT PART> OF PHRASE IS IN TOP OF STACK* 00669900 T 0873*0 

N0fc(I HOPE). IF REPEAT"! > THEN GO TO INLOOP TO 00670000 T 0873*0 

USE SAME PHRASE OVER, IF REPETE « THEN DELETE* 00670100 T 0873*0 

THE AND GO TO Si TO PICK UP NEXT PHRASEU 00670200 T 0873*0 

COMMENT R EDITING PHRASE;* 00670300 T 0873*0 

RTYPE** STREAMCP6 «-<FLG«-0)# COMMENT RETURNS FLAG AS TO WHAT IS* 00670400 T 0873*0 



W 



P5 * 0, 
P4 «• W> 


COMMENT 
COMMENT 


in buffer;* 
sign;* 
field widthu 


P3 * BUFF? 


COMMENT 


BUFFER CHARACTER ADDRESS;* 


Pi * Q)}% 






BEGINS 

SI * P3U 







LEADING BLANKS;* 
" THEN JUMP OUT TO 



# 

• 



TALLY *■ P4;» 
COMMENT SKIP 
P4CIF SC * " " THEN JUMP OUT TO RSIGN;* 

SI«-Sl + l;* 

TALLY * TALLY +63);C0MMENT TALtY"»U% 
COMMENT FALL THRU LOOP MEANS FIELD WAS BLANK;* 



NOI* 



TALLY*^! 

go to rxita;* 
tally «• tally 

SI ♦• Sl + i;% 

P4 <• tally; 



COMMENT SET FLAG TO U',% 



+ 63;% 

COMMENT 
THE "." 



A •», 
AND 



H WAS 
SET Fi 



FOUND 
.AG TO 



FIRST. 
6;* 



SKIP* 



TALLY «• bit 

go to rxita;* 
comment exponent found 



first;* 



EXPFRST* TALLY * TALLY +63/% 
SI <- si + u* 
P4 «■ tally;* 
tally * e; 
go to rxita;* 
comment look at first non-blank character/** 



COMMENT SET FLAG TO 8;* 



RSIGN: 



RXlTBi 



IF 
IF 

IF 
IF 
IF 
IF 
IF 
COMMENT 



SC = 
SC = 
SC = 
SC> 

sc» 
sc= 

SCe 
IF 



0" 



THEN 
THEN 
THEN 
THEN 
THEN 
THEN 
THEN 
OF 



GO 

GO 
GO 
GO 
GO 
GO 
GO 
THE 



TO 
TO 
TO 
TO 
TO 
TO 
TO 



rminus;* 

Rplus;* 

rplus;* 

rimplus;* 

noi;* 

expfrst;* 

expfrst;* 



ABOVE THEN ERRQRJX 



COMMENT PASS BACK A "1" FOR A"-"JX 



• 
• 



E" 
NONE 

rerr; tally * 2;* 
go to rxita;* 

RMTNUS: Dl * LOC PU)% 
01 * DI-1I 

D'S ■■«■ Lit " 1";* 

RPLUS: TALLY «• TALLY + 63;* 
SUSI + 1J* 
P4«-TALLY j * 
COMMENT SKIP BLANKS PAST SIGN (IF ANY) THEN LOOK AT* 

NEXT non*blank;* 

P4CIF SC/" " THEN JUMP OUT TO RXlTB;* 
SI*Si*i;% 

TALLY «■ TALLY + 63);* 
GO TO RERRU 

rimplus- P4 «. tally;* 

TALLY <- o;* 
RXITA: P3 * $U% 

P6 ♦• TALLY;* 

end;* 

buff «• p; comment address of next character;* 

wt «• p; comment remaining field;* 



00670500 


T 


0874*0 


00670600 


T 


087450 


00670700 


T 


087411 


00670800 


T 


087452 


00670900 


T 


0875'0 


00671000 


T 


0875'2 


00671100 


T 


0875«2 


00671200 


T 


0875*3 


00671300 


T 


087612 


00671400 


T 


0876«2 


00671500 


T 


0878«0 


00671600 


T 


087851 


00671700 


T 


087853 


00671800 


T 


087853 


00671900 


T 


087950 


00672000 


T 


087951 


00672100 


T 


087952 


00672200 


T 


087953 


00672300 


T 


088050 


00672400 


T 


088050 


00672500 


T 


088051 


00672600 


T 


088052 


00672700 


T 


088052 


Q0672800 


T 


088053 


00672900 


T 


088150 


00673000 


T 


088151 


00673100 


T 


088112 


00673200 


T 


088153 


00673300 


T 


088153 


00673400 


T 


0882*2 


00673500 


T 


088351 


00673600 


T 


088450 


00673700 


T 


0884*3 


00673800 


T 


088552 


00673900 


T 


088651 


00674000 


T 


088750 


00674100 


T 


088750 


00674200 


T 


088751 


00674300 


T 


088752 


00674400 


T 


088753 


00674500 


T 


088850 


00674600 


T 


088852 


00674700 


T 


088853 


00674800 


T 


088950 


00674900 


T 


088951 


00675000 


T 


088951 


00675100 


T 


088951 


00S75200 


T 


0890 5 3 


00675300 


T 


089150 


00675400 


T 


089152 


00675500 


T 


089i5 3 


00675600 


T 


089250 


00675700 


T 


0892*1 


00675800 


T 


0892*2 


00675900 


T 


0892*3 


00676000 


T 


089350 


00676100 


T 


0893*2 



i 






% •#. 



'* » 



c 



• 



SGN * 
GO TO 



• 



RBLF* 
RFAS 

RIPAR 
RIPRT 

RDOnA 

rdone 



T? 



N 



: 



MAXI* 

RFCl 



: 



GO 

GO 
GO 
60 



TO 
TO 
TO 
TO 



PJ 
RIPARTJ 

rerra; 

RBLFJ 
RFAJ 

COMMENT 



U 



COMMENT 
COMMENT 
COMMENT 

COMMENT 
COMMENT 
COMMENT 

FALL THRU 



SAVE SIGNJI! 

... _... „.. KEYJ% 

<SIGN><DIGIT> OR <OlGIT>J 

ERROR;* 

BLANK FIELD;* 

<SIGN> n ." OR ".";* 

8 =<SIGN> <EPONENT> OR* 



KEY 
KEY 
KEY 
FOR 



JUNK1 * 

Wl «• OJ 

GO TO REXPJ 

COMMENT 
P(0*SSN); 

go to cqmb;* 

COMMENT 

junki «■ o; 

FLG * 1 J 



SWITCH ON 
KEY * 
s 2 
9 4 
m ,6 
KEY 

<EXPONENT>j% 
COMMENT MANTISSA ♦ UX 
COMMENT DECIMAL PLACES;* 
COMMENT OUT TO DEVELOP EXPQNENTJ% 
BLANK FIELD;* 

COMMENT SET RESULT TO -0J% 



t» »t 



NO INTEGER* 



GO 



GO 
IF 



Wl 
W2 



REXpJ 



found first;* 
comment mantissa «• 0*x 
comment set flg to remember 

PARTJ% 

to Rfpart;* 

COMMENT DIGIT FOUND FIRST;* 
P(U; COMMENT CALL GETNUM TO BUILD OCTAL* 

INTEGER PARTJ* 
TO GETNUMJ% 

NOT P THEN GO TO RFCJ COMMENT BRANCH ON KEY GETNUM* 
RETURNS. IF NO BRANCH THEN WE HAVE FIELD EXAUSTED** 
I.E. IMPLIED DECIMAL;* 
«- DJ COMMENT DECIMAL PLACES IN FRACTION;* 

«• o; comment no exponent;* 
comment build result;* 
pcjunkd; comment get number;* 
if sgn then pcssn)/ comment insert sign;* 
comment scale number;* 

IF PCW2 + SCFTR-Wl'DUP) > 0* 

then p(tencp3#mul)% 
else p(ten[-p3»/);* 

go to comb;% 

^7777777777777} 

comment the field is not exausteou 

ht * wt «i; comment wt*l to account for character* 

ending integer field;* 
if w2 = "," then go to rfpart;* 

comment out for visable decimal pointj* 

go to rerraj* 

comment error if implied point to right* 
of mantissa field;* 

comment calculate decimal position from* 

decimal places and position of rlgt most* 

digit in mantissa;* 

COMMENT LOOK FOR AND CONVERT AnY EXPONENT FOUNDS 
STREAMC* 

P6 *• 0, COMMENT 

COMMENT 



IF WT i THEN 



Wl ♦• d-wt-i; 



0, 
P5*WT+1* 
P4«- BUFF** 
P3«-l I 

pf*0);% 

BEGIN COMMENT LOOK 
SI * P4; Si .. 



PLACE TO RETURN 
REMAINING FIELD 



exponent;* 
width;* 



COMMENT FLAG;* 



FOR 
SI 



E OR 

•i;% 



p;* 



00676200 

00676300 

00676400 

00676500 

00676600 

00676700 

00676800 

00676900 

00677000 

00677100 

00677200 

00677300 

00677400 

00677500 

00677600 

00677700 

00677800 

00677900 

00678000 

00678100 

00678200 

0067830Q 

00678400 

00678500 

00678600 

00678700 

00678800 

00678900 

00679000 

00679100 

00679200 

00679300 

00679400 

00679500 

00679600 

00679700 

00679750 

00679800 

00679900 

00680000 

00680100 

00680200 

00680300 

00680400 

00680500 

00680600 

00680700 

00680800 

00680900 

00681000 

00681100 

00681200 

00681300 

00681400 

00681500 

00681600 

00681700 



T 

T 
T 

T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 



0894*0 
0894*2 
0894*3 

0895*1 
089513 
0896*1 

0896*3 
0896*3 
0896*3 

0897*2 

0898*1 

0898*3 

0898*3 

0899*1 

0899*3 

0899*3 

0900*2 

0901*1 

090i»l 

0901*3 

0901*3 

0902*0 

0902*0 

0902*2 

0903*0 

0903*0 

0903*0 

0903*3 

0904*2 

0904*2 

0904*3 

0905*3 

0905*3 

0907*2 

0908*3 

0910*0 

0910*2 

0912*0 

0912*0 

0913*1 

0913*1 

0914*2 

0914*2 

0915*3 

0915*3 

0915*3 

0917*2 
0917*2 
0917*2 
0917*2 
0917*3 
0918*0 
0918*3 
0919*0 
0919*2 
0920*0 
0920*0 



RAB* 



TALLY «■ P5;* 

P5( IF SCX " " THEN JUMP OUT TO RAA;* 
SI «• Si + 1?% 

tally * tally + 63jk0mment tally - 1 i% 
go to rexta; comment out if no exponent;* 
if scs m e w then go to rab;* 
if sc=«£» then go to rab;* 

* o; comment improper exponent'* 
tally;* 
a;* 

comment look for exponent sign;* 
tally «• tally + 63;* 

SI <• SI + \t% 

IF 5C="-" THEN* 
bEGIN* 

P5 <• TALLY;* 

TALLY «• i;% 

Pi * tally; 

TALLY * P5;% 
GO TO REP;* 



RAA: 



raeritally 

P3 * 

GO TO REXT 



COMMENT REMEMBER 



sign;* 



end;* 

IF SC 
BEGIN 
REp: 



REXTA 
RAERA 

end;* 

IF SC 



="+" THEN* 
* 

tally * tally 
P5«-tally; 
si *- si •* i; 

P5CJUMP OUT TO 
GO TO raer; 

? go to rext;* 
s go to Raer;* 



* 63;* 

comment skip over sign;* 
rado; comment out if field not* 
exausteo cp5/0);* 
comment out on error;* 



if not digit-error;* 



'"S" THEN GO TO REP;* 
COMMENT LOOK FOR DIGITS IN EXPONENT;* 
RAOC: IF SC < "0" THEN GO TO RAER;* 

COMMENT OUT 
TALLY «■ TALLY +63;* 

P5 * tally;* 

COMMENT LOOK FOR 2ND DIGIT;* 
P5CSI*Sl+i;* 

IF Sc*"0« THEN* 
BEGIN* 

si*si«i;* 

DI «- LOC P6;* 
DS *> 2 OCTj* 
TALLY «- TALLY + 63;* 
P5 * TALLYj* 
JUMP OUT TO RAIS;* 
END/* 
IF SC* M " THEN JUMP OUT TO RAER;* 
SI * Si - U JUMP OUT TO rao;* 
RACJ DI <■ LOC P6;* 
DS * OCT'* 
COMMENT PUT IN EXPONENT SIGN SAVED IN PU* 
RAIS.* P1CDI <• LOC P6;* 

DS «• LIT « + »);* 
P5( IF SC i " " THEN JUMP OUT TO RAERA;* 



00681800 T 
00681900 T 
00682000 T 
00682100 T 
00682200 T 
00682300 T 
00682400 T 
00682500 T 
00682600 T 
00682700 T 
00682800 T 
00682900 T 
00683000 T 
00683100 T 
00683200 T 
00683300 T 
00683400 T 
00683500 T 
00683600 T 
00683700 T 
00683800 T 
00683900 T 
00684000 T 
00684100 T 
00684200 T 
00684300 T 
00684400 T 
00684500 T 
00684600 T 
00684700 T 
00684800 T 
00684900 T 
00685000 T 
00685100 T 
00685200 T 
00685300 T 
00685400 T 
00685500 T 
00685600 T 
00685700 T 
00685800 T 
00685900 T 
00686000 T 
00686100 T 
00686200 T 
00686300 T 
00686400 T 
00686500 T 
00686600 T 
00686700 T 
00686800 T 
00686900 T 
00687000 T 
00687100 T 
00687200 T 
00687300 T 
00687400 T 






0920*2 
0921*1 
092213 
0923*0 
0923*2 
0923*3 
0924*2 
0925*1 
0925*2 
0925*3 

0926*0 
0926*0 

0926*1 
0926*2 
0927*0 
0927*0 
0927*1 
0927*2 
0927*3 
0928*2 
0928*3 
0928*3 
0929*1 
0929*1 
0929*2 
0929*3 
0930*0 
0931 : l 
0931*1 
0931J2 
0931*3 
0932*0 
0932*0 
0932 83 
0932*3 
0933*2 
0933*2 
0933*3 
0934*0 
0934*0 
093^*3 
0935*1 
0935*1 
0935*2 
0935*3 
0936*0 
0936*1 
0936*2 
0937*0 
0937*0 
09 3810 
0939*0 
0939*1 
0939*2 
0939*2 
0940*1 
094U0 



* ■**■.*■ 



v *0+ 



-4 ** * 



& 



SI * SI + 1)|X 

rext* P4 «■ Si;x 
end;* 
if not p then go to rerra* comment out on errors 

BUFF «- P|% 
P(DEL)*% 

w2 *pi comment exponent** 
go to hdone** 



RFPARTS P 






TU MQUNt>% 

COMMENT WE COME HERE IF A "." IS FOUND IN FIELD** 
(JUNK1#CADDRS]#STD);% 

COMMENT SAVE INTEGER PART IN AODRS** 
IF (JUNK2 * WT) $ THEN* 



* 



BEGIN COMMENT ",« WAS LAST IN FIELD*! 
IF FLG THEN GO TO RERRA** 

COMMENT ERROR IF ONLY A "." WAS FOUND* 
Wl * 0* COMMENT INDICATE NO FRACTION PART* 
GO TO RDONA** 
END** 
P<0)** 

GO TO GETNUM* COMMENT CALL GETNUM TO 8UILD FRACTION** 
RFPRTN5 IF (Wl *■ JUNK2 - WT) ? THEN* 

BEGIN COMMENT FRACTION PART IS BLANK** 
IF FLG THEN GO TO RERRA;* 

COMMENT ERROR IF ONLY " , " IN FIELD** 
r m n * % 

COMMENT DEVELOP NUMBER** 
JUNK1 * JUNK1 ♦ ADDRS x TeNCWUJI 

COMMENT INTEGER FART * 10?<DECIMAL PLACES> 
+ FRACTION PART** 
IF P THEN GO TO RDONA** 

COMMENT BRANCH ON KEY GETNUM RETURNED.* 
IF TRUE THEN FIELD ExAUSTED** 
WT «• WT -1* COMMENT WT-1 TO ACCOUNT FOR CHARACTER* 

ENDING FRACTION PART** 
GO TO REXP* COMMENT CHECK FOR EXPONENT** 
COMMENT SUB-PROGRAM USED BY RETYPE** 

COMMENT GETNUM BUILDS AN OCTAL INTEGER FROM THE BCL* 
FOUND IN THE BUFFER** 
GETNUMJ! P<1>* COMMENT FLAG USED AT GRTN** 

GRTY* STREAMC* 

P6*0> COMMENT RETURN CHR ENDING INTEGER** 

P5«-[D13> COMMENT POINTER TO BCL INTEGER** 
P4«-C IF WT > 16 THEN 16 ELSE WT)** 

COMMENT WT * FIELD WIDTH** 
P3*8UFF:* 
PU 0)** 
BEGIN* 

SI #. P3** 
DI * P5** 

PH(IF SC < "0" THEN JUMP OUT TO RENDM** 
DS + CHR** 
TALLY *> TALLY + 1)** 
GO TO RCXIT** 
RFNDM! DI * LOC P5** 
DI ♦■ DIM** 

DS «■ CHR* COMMENT RETURN CHARACTER ENDING* 

INTEGER FIELD** 



00687500 
00687600 
00687700 
00687800 
00687900 
00688000 
00688100 
00688200 
00688300 
00688400 
00688500 
00688600 
00688700 
00688800 
00688900 
00689000 
00689100 
00689200 
00689300 
00689400 
00689500 
00689600 

00689700 
00689800 
00689900 
00690000 
00690100 
00690200 
00690300 
00690400 
00690500 
00690600 
00690700 
00690800 
00690900 
00691000 
00691100 
00691200 
00691300 
00691400 
00691500 
00691600 
00691700 
00691800 
00691900 
00692000 
00692100 
00692200 
00692300 
00692400 
00692500 
00692600 
00692700 
00692800 
00692900 
00693000 
00693100 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



094282 
0943*0 
0943*1 
0943*2 
0944*0 
0944»2 
094413 

094511 
0945*3 
0945' 3 
0946*2 
0946*2 
0947*3 
0948*1 
0949*1 
0949*1 
0950*0 
0950*2 
0950*2 
0950*3 
095l!l 
0953*0 

0953*2 
095412 
0954*2 
0954*2 
0954*2 
0956*2 
0956*2 
0956*2 
0957*1 
0957*1 
0957*1 
0958*2 
0958*2 
0959*0 
0959*0 
0959*0 
0959*0 
0959*1 
0959*2 
0959*3 
0960*0 
0962*1 
0962*1 

0962*3 
0963*1 
0963*1 
0963*2 
0963*3 
0965*1 
0965*2 
0966*0 
0966*1 
0966*2 
0966*3 
0967*0 



RCXITS 



P3 
P4 



si; 
tally; 



comment next buff address;* 
comment return number of digits* 
in integer;* 



end;* 



• 



grtn* 



BUFF «• P, 

wl *■ p; 
pcded; 

W2 * p; 
if not p 



COMMENT 
COMMENT 
COMMENT 
COMMENT 



BUFF * 
Wl * 
DELETE 
W2 * 



P3;* 
P4;* 

P5)* 

P6i% 



THEN GO TO GTD; 



STREAMC* 
P7 * 
P6 «• 



COMMENT BRANCH 
IN AT GRTY OR 



ON FLAG 

gtc;* 



PUT* 



P(Wt'DUP) 
(IF P < 8 
COMMENT T 



• 
• 



*0» 

* tons 

* o>;% 

P3',% 

LQc P4;i 
P6 oct;% 

LOC P5U 

. p? oct;; 



GT8* 



GTC* 



p 5 

P4 
P3 
PI 
BEGIN* 

SI* 
DI* 
DS* 
DI* 
DS 

end;* 

pcded; 
p(ten8,mul#add 

COMMENT 
PCDEL*DEL); 
IF (WT * WT-W1 
BEGI 

PC1> 

GO T 

END' 

COMMENT FIELD 

IF W2 > 9 THE 

BEGIN COM 

P. CO* 

GO T 

end;* 
p(0)j go to gr 



>% 
THEN ELSE P <8#SU8»8* XCH } ),% 

HE ABOVE IS "IF WT S 8 THEN P7*WT*P6*0 
ELSE P7*8»P6«-WT-S"JX 
COMMENT OCTAL OF RIGHT 8 DIGITS;* 
COMMENT OCTAL OF WHATS LEFT;* 
COMMENT ADDRESS OF BCL INTEGER** 



GTD' JUNKl * JUNKl 

GO TO gtb;* 

NUMXIT! IF P THEN GO TO RIP 
COMMENT DATA ERROR 
RERRAJ IF FILX.C18«153>1 THEN 

BEGIN PARL«-FILX[NOT 
ELSE BEGIN 

if filx,c1.8»153«1-t 

end ; 

IF PARL s THEN PC 
ELSE PC 
COMMENT IF NO 



COMMENT DELETE P3;% 
, ,UUNKi*STO);* 
JUNKl * P4 x 10*8 + P5i* 

COMMENT DELETE P6 & P7;* 
) < THEN* 

N COMMENT PASS BACK A KEY OF 1 TO* 
FLAG FIELD EXAUSTEDU 

xcH);* 

NUMXIT* 

% 

NOT EXaUSTED SO LOOK AT WHAT ENDED IT) 

N% 

MENT MANTISSA EXAUSTED BUT NOT FIELD* 

SO RETURN A FLAG QF 0)* 
XCH3J* 
NUMXfT;* 

TY; COMMENT MANTISSA NOT EXAUSTED** 
SCALE NUMBER LEFT UNTIL IT IS)* 
x TENCWim 

RTN ELSE GO TO RFPRTN)* 
READING R FORMAT)* 

3]; FILXCNOT 33*FILXtNOT 4]*0 END 
HEN P(FILX#14.C0M); PARL*0) FILX**2 ) 

FILX.t33il5]*7jil»C0M) 

PARL*MkS,9*BLKCNTL))* 

PARITY ACTION LABEL PRINT "RER"* 



00693200 
00693300 
00693400 
00693500 
00693600 
00693700 
00693800 
00693900 
00694000 

0©694100 
00694200 

00694300 
00694400 
00694500 
00694600 
00694700 
00694800 
00694900 
00895000 
00695100 
00695200 
00695300 
00695400 
00695500 
00695600 
00695700 
00695800 
00695900 
00696000 
00696100 
00696200 
00696300 
00696400 
00696500 
00696600 
00696700 
00696800 
00696900 
00697000 
00697100 
00697200 
00697300 
00697400 
00697500 
00697600 
00697700 
00697800 
00697900 
00698000 
00698100 
00698150 
00698200 
00698300 
00698400 
00698500 
00698600 
00698700 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 



0967*0 
0967*1 

0967*2 
0967*2 

096713 
0968*1 
0968*3 
0969*0 
0969*2 
0970*0 
0970*0 

0970*1 
0970*3 
0973*2 
0973*2 
0973*2 
0973*3 
0974*0 

0974*2 
0975*0 
0975*0 
0975*1 
0975*2 
0976*0 
0976*1 
0976*3 
0977*0 

0977* 1 
0978*2 
0978*2 
0979*0 
0980*3 
0981*1 
0981*1 
0981*3 

0982*1 
0984*0 
0984*0 
0984*3 
0985*1 
0985*1 
0985*3 
0986*1 
0986*1 
0987*0 
0987*0 
0988*2 
0989*0 
0990*0 
0990*0 
099111 

0997*0 
0997*2 
1001*1 
1002*0 
1004*3 
1006*1 






4 



*t <«• »•!.* 



*-■* #■ 



Hf 



• *■* 



• #* 



^■"^■wft 



END INPUTINT;% 



error and 
label;* 



TERMINATE ELSE GO TO PARITY% 



00698800 T 1006«1 
00698900 T 100611 
00699000 T 1006* 1 

SIZE* 1007 WORDS 



PROCEDURE DISKSORTC 

START OF REL 
T1,T2,RELA* 

ENDQ*8INGO.MPFIDX#OUTPROMNPRO*OUTFMNF# 
QPTaG*IPTQG>DK0,DKI>TPl>TP2*TP3*TP4,TP5*NT> 
HIVALU#E9UALS,R,ALFA^C0RESIZE*DISKSIZE); 
COMMENT DISK-SORT 8Y L.R. GUCK DATE 9/19/1965 ; 






REM 



BOOLEAN 

REAL 

NAME 
REAL 



VALUE 

ENDQ* 

BINGO' 

IPFIDX* 

OUTPRO* 

INPRO* 

OUTF* 

Tl* 

T2* 

RELA* 

inf; 

OPTOG* 

iptog; 

DKO» 

dki; 



L.R. 

OPTOG*lPTOG^NT»HlVALU»EQUALS'R*ALFA* 
CORESIZE'OISKSIZEJ 



* POINTER TO DESC WHICH DESCRIBES OUT AREA 



% POINTER TO DESC WHICH DESCRIBES INPUT AREA 
% TRUE IF OUTPUT PROCEDURE 
% TRUE IF INPUT PROCEDURE 
% DISK OUTPUT FILE 
* DISK INPUT FILE 

TAPES 



TP!»TP2#TP3#TP4»TP5; 

% FOR FURTURE 



I SCRATCH 
USE 



KEY COMPARE ROUTINE 
RECORD: <0 FOR ALGOL 
TRUE FOR ALPHA KEYS 
CORE STORAGE AVAILABLE 
DISK STORAGE AVAILABLE 



NT' 

HIVALU* 
EQUALS/ % 

INTEGER R; % 

BOOLEAN ALFAJ % 

REAL CQRESIZEJ % 

INTEGER DISKSIZE; % 

BEGIN 

LABEL GRA»RTNRO>WRTBLOCRTNDW,Sa>RTNDR# 

ipb,ip6a'ipc*ipd»ipe*ipg> 
mic,mi0,mie,rta, 

start* ly#lz,lx*callsort»endsqrtpass, 
dkc,dkd,oke,dkf, 
tpa>tpb,tpc>wrapup»sqrtdone; 
comment general parameters; 



REAL S* * 

M» % 

MS* % 

STpP, % 

D* % 

OD* % 

BF, % 

TBO' * 

Ij-X'y; % 
array 0atac*»*3; 



MATRIX SIZE FQR SORT PASS 

MATRIX SIZE FOR MERGE PASS 

CURRENT MATRIX SIZE 

INDEX OF LAST ADDRESS IN VECTOR 

SEGMENTS PER DISK INPUT BLOCK 

SEGMENTS PER DISK OUTPUT BLOCK 

RECORDS PER DISK INPUT BLOCK 

RECORDS PER DISK OUTPUT BLOCK & 

TEMPORARY STORAGE 

ARRAY DATX * DATAC*]; NAME DATN 



CV) ARRAY 

tape blocking 
* data; 



00700000 

segment; DISK 

00700100 
00700200 
00700300 
00700400 
00700500 
00700600 
00700700 
00700800 
00700900 
00701000 
00701100 
00701200 
00701300 
00701400 
00701500 
00701600 
00701700 
00701800 
08701900 
00702000 
00702100 
00702200 
0@702300 
00702400 
00702500 
00702600 
00702700 
00702800 
00702900 
00703000 
00703100 
00703200 
00703300 
00703400 
00703500 
00703600 
00703700 
00703800 
00703900 
00704000 
00704100 
00704200 
00704300 
00704400 
00704500 
00704600 
00704700 



T 0000 

ADDRESS 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000 
0000 
0000 
0000 
0000 
0000 
0000 

0000 

oooo 

0000 

oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
ooon 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 
oooo 

"^000 



JO 

s 

JO 
10 
10 

so 

10 
JO 
10 
50 
JO 
JO 
JO 
10 
JO 
JO 
JO 
JO 
SO 
JO 
JO 
JO 
JO 
JO 
JO 

so 

JO 
JO 

to 

JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 

so 
to 

JO 

so 
so 

JO 

JO 

so 
to 
so 

JO 



00145 



ARRAY Vt*]; NAME VN a VJ 
DEFINE VX1*FLAGCVCX+13)*# 



VX«FLAG(VEX])## VL=FLAG(VCVLQW3)#; 



• 



DEFINE VA1 s FUAGCVCX+l 3&P( 0* RDS ) [ CTF3 } t> 
VA = FLAG(VCX 3&P(Q*RDSHCTF3)#» 
XAU= *[INFlL3*0'RDS*cFX#> 
VAt « FLAG(VCVLOW3&PCO*RDS3CCTF3)#; 

REAL VLOW; % INDEX OF NEXT RECORD IN SEQUENCE 

ARRAY MHKC*]J % HIGH KEY FOR MERGE PHASE 

NAME MHNsMHk; 

BOOLEAN MQREOATA* % GOES FALSE WHEN NO MORE INPUT 



DATA 



FM* 
EOF* 
TM* % 
MF=Tt» % 
OFslPTOG* 



ON LAST MERGE PASS 
WHEN INPUT FILE EXAUSTED 
BACK-UP TAPES 



% TRUt 

* TRUE 

TRUE FOR SORT WITH 

TRUE IF MERGE ONLY 

% TRUE IF OUTPUT 



FILE 
DISK 



IS A DISK 
SPACE IS FULL 



DISKFULL; % TRUE WHEN ASSIGNED 

REAL TR; % t OF RECORDS QF DATA SAVED ON DISK 

DEFINE IOC - e2000000000#> 

POLYMERGE * PRTB ASE [ RELA ] * PCDUP*LOD )&1 [6 S47 * 1 3 #** 
COMMENT PARAMETERS RELATED TO PROGRAMMERS FILES) 
NAME INFIL * INF; % POINTER TO TOP I/O DESC, 
NAME WAIN - IPFIDXJ % C0B0L68 INFILE WORK AREA 
NAME OUTFIL = QUTF; 

NAME WAOUT = 12) % C0B0L68 OUTFILE WORK AREA 

ARRAY PRFIBU3; % CONTAINS TAPE FILES FIB 
REAL ACJ * TRUE FOR COBOL INPUT FILE 
REAL INCQUNT, % COUNTS # OF RECORDS FROM INPUT FILE 

dutcqunt; % counts * of records written on output 
comment pointers for standard procedures; 
name mem » z> 
array fpb = 3c*3> 
real block = 5* 

ALWR a 12* 

ALRD " 13* 

COFCR * 12* 

PERFORMQEN « 13* 

CORW * 14* 
ALFCR =s 14* 

BLKCTR s 16; 
ARRAY PRTBASE s 10E*3J 
COMMENT PARAMETERS RELATED TO 
NAME DOTOP ■ DKO; % POINTER 
ARRAY 0UTFIB[*3; % POINTER TO 
OUTHEADC*3; % POINTER TO 



FILE 



ARRAY 
REAL 



% C0B0L68 IN-OUT PROCEDURES 



DISK OUTPUT FILE; 
TO DISK OUTPUT I/O DESC. 
FIB 
FILE HEADER BLOCK 



DEFINE 
DEFINE 
COMMENT 



LQSA* 

ONS* 

ORC* 

OCDA* 

ORL* 

ORI* 
SRI* 
SRS* 

Dec; 

ORS = 
FNUM 



% DISK ADDRESS OF CURRENT STRING TAG WORD 
% RUNNING COUNT OF STRINGS IN OUTPUT AREA 
% RUNNING COUNT OF RECORDS IN STRING 
X DISK ADDRESS OF NEXT AVAILABLE OUTPUT AREA 
% RUNNING COUNT OF NUMBER OF SEGMENTS LEFT IN 
* CURRENT ROW 
% CURRENT ROW BFlNG USED 
% ROW WHERE STRING STARTED 

% NUMBER OF SEGMENTS OF STRING IN ROW SRI 
% CURRENT « OF RECORDS IN OUTPUT BUFFER 
OUTHEADC83#; 

aUTFIBC/4l,C13SH3#; 



PARAMETERS FOR DISK INPUT FILE; 



00704800 

00704900 

00704910 

00704920 

00704925 

00704930 

00705000 

00705100 

00705200 

00705300 

00705400 

00705500 

00705600 

00705700 

00705800 

00705900 

00706000 

00706100 

00706200 

00706300 

00706400 

00706420 

00706500 

00706520 

00706600 

00706700 

O0P06800 

00706900 

00707000 

00707100 

00707110 

00707200 

00707300 

00707400 

00707500 

00707510 

00707600 

00707700 

00707800 

00707900 

00708000 

00708100 

00708200 

00708300 

00708400 

00708500 

00708600 

08708700 

00708800 

00708900 

00709000 

00709100 

00709200 

00709300 

00709400 

00709410 

00709500 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 
OOOQJO 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 

ooooio 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
OOOO'O 
0000*0 
0000*0 
0000*0 



*nr. *»• «■» 



f-« 



* ■fpr-t* 



a P*. 



+*^j|. 






ARRAY I 
ARRAY I 

I 
ARRAY B 

I 
BU 
REAL II 
DEFINE 



• 



COMMENT 
INTEGER 

INTEGER 

NAME 

NAME 

ARRAY 

ARRAY 

ARRAY 

NAME 

REAL 

NAME 



TNK 5 
NFIBC 

NHEAD 
ASEC* 
TQP[* 
FFC * 3 

sa; 

IBC = 

IRL = 

ISL = 

IDA = 

IRC « 

FCR = 

PARA 

CT 

CO 

CO 

TP 

TS 

TC 

TN 

TS 

TM 

CI 



DKIC 
*3> % 

i*H 

BASE 
BASE 
BASE 
BASE 
BASE 
IF A 

METER 

RL' 

iod; 
c*3; 

NsTS; 

i=cor 
iod; 



*]; % 
point 

% POI 
% POI 

.■% poi 
% i 

% HOL 
Co3## 
Cl3#» 
C2]## 
C31#* 
[43#> 
C THEN 
S RELA 
35 C 
% C 
L 
B 



POINTER TO INPUT TANK 
ER TO FIB 

NTER TO FILE HEADER BLOCK 
NTER TO CONTROL INFO IN DATA 
NTER TO TOP I/O DESC 
/Q DESCRIPTOR 

DS TAG ADDRESS FOR NEXT MERGE PASS 
% RECORDS LEFT IN BLOCK 
% RECORDS LEFT IN STRING 
BLOCKS LEFT IN ROW 
DISK ADDRESS OF NEXT BLOCK 
CURRENT ROW QF THIS STRING 
ALFCR#; 



% 



% A 



% 

% 

% 
COFCR FLSE 
TED TO MERGE TAPES; 
URRENT CONTROL TAPE 
URRENT nUTPUT TAPE 

OC OF I/O D OF CURRENT OUTPUT TAPE 
ASE POINTER OF MERGE TAPES 
RRAYS FQR CONTROLLING DISTRIBUTION 
PATTERNS ON MERGE TAPES 



NAME TCN«TC; NAME TNN=TNJ 
esize; % TAPES - 1 

% LOC DF I/O D FOR CURRENT INPUT TAPE 



%****#********************* ********% 



SUBROUTINE WAIT; COMMENT WAIT FOR I/O COMPLETE USING ADRRESS 

ON TOP OF STACK; 
$ SET OMIT = NOTCTlMESHARlNG) 

BEGIN IF NOT C PC XCH,DUP>LOD ) ) ♦ 1 19 J 1 3 THEN PC IOC, 36,CQM*DEL >> 
$ POP QMIT 
$ SET OMIT s TIMESHARING 

IF NOT PCLQD,0UP),C2U] THEN % CHECK FOR ERRORS 
IP NOT CPCDUP»DUP).C27U] ANq P(XCH) . C7l t 3 ) THEN 

PCUXCH* MEM[P inx NOT 1] iNX P( 2,LNG, XCH ) > 12* \1 '» COM)! 

pcded; END wait; 

%***************MM*****************% 
SUBROUTINE RELEASETAPE; % CALLS MCP TO WRITE OUT BUFFERS 
BEGIN 
PRFIBU13 * TBO; 
PCCOIODC03 <- FLAGCPRFlBtl63)»COIOD#PRL*DEL); 

rtaj pccoiod); wait; 

IF C*C0I00).C27il] then % reel switch 

BEGIN 

p(mks»0 # 0»cc0i0dcn0t 23 3»6>fcr); 
go to rta; 
end; 

COlODtO] «■ 1 INX FLAGCPRFIBC163 *■ NFLAGC *COlOD ) )i 
END RELEASETAPE; 
SUBROUTINE TAPEWRlTE; % BLOCKS OUTPUT TAPES 
BEGIN 

PRFIR * *tColODtNOT 233; 

PRFI8C9] «■ PRFIBC93 * It % RECORD COUNTER + 1 
IF CPRFIBCH3 * PRFIBC113 - 1) > THEN % BLOCK COUNTER 
COIODC03 *■ R INX *COIOD 

ELSE 
BEGIN % TIME FOR RELEASE 

PCO,PRFIBCl63 INX MEM>STD); % ZERO CONTROL WORD IN BUFFC23 



00709600 
00709700 

00709800 
00709900 
00710000 
00710100 
00710200 
00710300 
00710400 
00710500 
00710600 
00710700 
00710800 
00710900 
00711000 
00711100 
00711200 
00711300 

0071U00 
00711500 
00711600 
00711700 
007U800 
00711900 
00712000 
00712100 
00712200 
00712250 
00712252 
00712253 
00712299 
0©712340 
00712350 
00712360 
00712400 
00712500 
00712600 
00712700 
00712800 
00712900 
00713000 
00713100 
00713200 
00713300 
00713400 
00713500 
00713600 
00713700 
00713800 
00713900 
00714000 
00714100 
00714200 
00714300 
00714400 
00714500 
00714600 



T 
T 

T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 

OOOOJO 
0000*0 
0000*0 

ooooio 

000010 
0000*0 
0000*0 

OOOO'O 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000i»0 
0001 »o 
0001*0 
0004*0 
0004*0 
0004*0 
0005*1 
0008*0 

0012*1 
0014*0 
0014*0 
0014*0 
0014*0 
0015*1 
0017*2 
0019*0 
0020*0 
0020*2 
0024*1 
0024*3 
0024*3 
0027*3 
0028*0 
0028*0 
0028*0 
0029*3 
0031*3 
0034*1 
0035*0 
0036*1 
0036*3 



• 



OR DUMMY STRINGS 






THIS TAPE 
STRING CTR 



rEleasetape; 

END? 

end tapewritej 
subroutine writestopper; 

begin % writes end of string 
prfib * mcoiodcnot 233j 

X *■ PRnBC93&(TBO-PRFlBCin)Cl8833:i53&C"DS M }C3!33!l53; 

P(X»PRFIBC16] INX MEM*STD); 

TNCCOT1 *■ TNCCOT] + i; % COUNT UP STRINGS FOR 
RELEASETAPE; 
PRFIB [93 * ; * ZERO OUT 

END WRITESTOPPER; 

%*** **#***************•************% 

SUBROUTINE QPENQUT; % OPENS PROGRAMMERS OUTPUT TAPE 
BEGIN 
IF OPTOG THEN 

BEGIN P(M«S, [ OUTF IL 3 »R» 1>1*1* BLOCK); 
IF AC THEN 

BEGIN BINGO «• QUTPRO* ENDO * o; 
IF AC. C46«ll THEN % C0B0L68 

BEGIN P£MKS#BIN60»0*PERF0RMGEN)I 
COIOD * [WAOUT3; 
WAOUT <- PC*tQUTFltl»0*COC)i 
END ELSE 
PCMKS»BlNGO#CPRTBASECP(DUPn3#LOD#IPFIDX,COC)J 
END END ELSE 

BEGIN DF * FALSE; PRFIB * OUTFILCNOT 2]; 
PRFI8C13] .C27I 11 <- 01 
IF AC THEN 
BEGIN 

P(MKS^C0UTFILCN0T 23 3 * 3#C0FCR )i 



DF 
IF 



♦• PRFIBU3.C8S43 
AC,U6*l3 THEN 



BEGIN 



end; 



COIOD 
WAOUT 



% C0B0L68 

CWA0UT3; 

PCPRFlB[20 3,CFF3*DUP*DIB 0*LQD*0* 
CDC*DEL»DIB 0,LOD); 



END 
ELSE 



begin pc [outfil 3 »0#11#c0m# deluded; 

pcmks*i,o*o*c-R)*coutfil3*alwr,del); end; 

END 

end openout; 
subroutine setuptapes; % initializes tapes for distribution pass 

BEGIN 

FOR I * STEP 1 UNTIL NT DO TSCI3 * TCCI3 * 

CTRL ♦ 0; TC[13 <• COT «- i; TMJ. * NT"1/ 



TNtii «• o; 



* TBOxR*i; 
DO 



TP ♦• ((NOT 5) INX [NT3); X 
FOR I M STEP 1 UNTIL NT 
BEGIN 

COIOD * TP[I3; PRFIB * *rCOlODCNOT 233; 

PRFIBC183 «■ X&XC3;33:i53&xC18*33:l53S(IXl)tt»4?ll3; 

PRFIBC 131 • C27S 1 1 «■ 0* % SET TO OUTPUT 

PRFIBC4],[7:i3 * C C AC AND 3) = 1); %C0B0L61 TAPE SORT 

PRFIBC93 *■ 0) PRFIBC113 * TBO; 

IF (Y*PRFIBE43,U2*123) < 1023 THEN 
PRFI8L43 ♦ PRFlB[43&(CY-l)xETRLNG)[l3!37;il3&ltl2t47»13; 



FLG 



00714700 
00714800 
00714900 
00715000 
00715100 
00715200 
00715300 

00715400 
00715500 
00715600 
00715610 
00715700 
00715800 
00715900 
00716000 
00716100 
00716200 
00716300 
00716400 
00716430 
00716440 
00716445 
00716450 
00716460 
00716500 
00716600 
00716700 
00716800 
00716900 
00717000 
00717100 
00717200 
0t7l7240 
00717250 
00717260 
00717270 
00717280 
00717300 
00717400 
00717500 
00717600 
00717700 
00717800 
00717900 
00718000 
00718100 
00718200 
00718300 
00718400 
00718500 
00718600 
00718700 
00718800 
00718900 
00719000 
00719100 
00719200 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0038*1 
0039*0 
0039»0 
0039? 1 
0040*0 
0040*0 
004i«3 

0045*0 
0046*2 
0048*2 
0050*0 
0051*1 
0053*0 
0053*0 
0053*0 
005310 
0053*1 
0055*2 
0055*3 
0058*1 
0059*0 
0060*2 
0061*1 

006283 
006213 

0065*0 
0065*0 
0068*0 
0070*2 
0070*3 
0071 II 
0073*0 
0075*0 
0075*3 
0077*0 
0079*1 
0080*3 
0080*3 
0080*3 
0082*3 
0085*0 
0085*0 
0085*1 
0085*1 
0086*0 
0086*0 
0092*2 
0096*1 
0099*2 
0101*0 
0101*0 
0104*1 

0108*2 
0111*0 
0114*2 
0117*0 
0119*0 



C 



• 
t 



■• ' ititt, m 



i 



if i * nt then p c c co iod 3 » om 1 * com* del* del ) % open tapes 

else prfibu83 * abs cprf ib [ 1 83 ) ; 
if i * nt then begin pccoloo); wait* end! 
if i - 1 then coiooco] «- 1 inx *coioo* 
end; 

COIOD <- TPtCOT] i 
END SETUPTAPESi 

SUBROUTINE GETROW* % GETS DISK SPACE FOR NEXT ROW IN OUTPUT AREA 
BEGIN ORL * ORS; 

IF CORI * ORI + 1) > 30 THEN % DISK SCRATCH FILE IS FULL 
BEGIN 
GRAJ IF NT < 3 THEN PC 1« [OOTOP [ NOT 23 3 * 84* 17, COM )i 
IF NOT TM THEN SETUPTAPE5; 
TM «• DISKFULL <- TRUE* 
END 

ELSE 
IF (OCDA «- QUTHEADCORl]) s THEN % GET DISK SPACE 
BEGIN 
P(FPBCFNUM+3 3*FPBCFNUM3*FPB£FNUM+13*0RI> 

.0uTHEAD*L0D*4*11*C0m*DEL*DEL*DEL*DEl*DEL*DED* 
IF (OCDA <■ 0UTHEADC0RI3) ■ THEN GO TO GRA; % NO DISK 
END 
END GETROW* 
SUBROUTINE FORGETDISK; % RETURNS DISK NO LONGER NEEDED 
BEGIN 
PRFIB «• P(XCH)* I *• 9? 

WHILE CI<-I + 1) < 29 DO IF PRFIB[I3 * 

THEN P(I *.PRFIB*L0D*24,C0M*DEL*DEL3* 
END FORGETDISK; 

sxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx* 

SUBROUTINE INROWCHKJ 
BE C I N 
IF CISI «■ ISL - 1) < THEN 
BEGIN 

ISL * CORS DIV OD ) x (00 DIV D)* % BLOCKS IN ROW 
IF INHEADCCIRC * IRC + CIRC < 29))3 / 
THEN IDA «■ INHEADURC3* 

END 
ELSE IDA «- IDA + D; 

END* 

SUBROUTINE INREADj COMMENT POINT INPUT BUFFER AT NEXT RECORD* 
BEGIN 

IF EOF THEN GO TO RTNRD* 
INCOUNT <- INCOUNT + 1* 
IF IPTOG THEN 

BEGIN IF AC THEN 
BEGIN COMMENT CALL INPUT PROCEDURE; 

IF AC.U6*13 THEN P( MKS* Bl NGO*0* PE.RF0RM6EN ) ELSE 
P(MKS*8lNGO*tPRT8ASECPCDUP>3 3*LOD*IPFIDX*COC>; 
EOF *■ ENDQ* 

end else eof «- p( mks* * [ infr3 * 0* inpro ) ; 
end 

ELSE 
BEGIN 

IF AC THEN EOF <- PC MKS* R* i INF IL 3*0* CORW ) % COBOL 



00719300 
00719400 
00719500 
00719600 
00719700 
00719800 
00719900 
00720000 
00720100 
00720200 
00720300 
00720400 
00720500 
00720600 
00720700 

00720800 
00720900 
00721000 
00721100 
00721110 
00721120 
00721200 
00721300 
00721400 
00721500 
00721600 
00721700 
00721800 
00721900 
00722000 
00722100 
00722200 
00722300 
00722400 
00722500 
00722600 
00722700 
00722800 
00722900 
00723000 
00723100 
00723200 
00723300 
00723400 
00723500 
00723600 
00723700 
0072380Q 
00723900 
00723980 
00724000 
00724100 
00724200 
00724300 
00724400 
00724500 
00724600 



0124*0 
0126*3 

0129*0 
0132*0 
013483 
Oi37«0 
0138*2 
0138*3 
0138*3 
0139*0 
0140*0 
0141*3 
0142*1 
0145*2 
0148*0 

0149*1 
0149*1 
0149*1 
0151*1 
0151S3 
0156*3 
0159*2 
0161*2 
016*12 
0161*3 
0*62*0 
0162*0 
0163*2 
0166*1 
0169*2 
0169*3 
0169*3 
0170*0 
0170*0 
0172*2 
0173J0 
0176*0 
0179*0 

0181*3 
0181*3 
0184*1 
0184*2 
0184*2 
0185*0 
0185*0 
0186*0 
0187*1 
0187*2 
0188*1 
0188*3 
019H0 
0193*1 
0194*0 
0196*1 
0196*1 
0196*1 
0196*3 



u 



ELSE 

BEGIN COMMENT ALGOL READ; 

P(MKS#0*0»[INFIL]#ALRD)J % READ FILE 

eof * pcmks#o*3*[infh.3»auro) < O; % 

end; 



WAIT FOR I/O 



RTNPD* 



end; 

IF EOF 



THEN VCVLOW] «■ NFLAGC*CDATXCS33H 
S[18»33U53SlC5|ft7ll3; 

end 1nread; 

diskwrite; comment blocks output buffer and 



SUBROUTINE 
BEGIN 
IF NOT P(XCH) 

ORC ■«• ORC + U 
IF (OBC <- OBC 
BEGIN COMMENT 



writes it; 
% write block if tos 



THEN GO TO WRTBLOC; 
* RECORD COUNT +i; 
•1) = THEN 51 IF BUFFER EXAUSTED 
BUFFER IS FULL SO WRITE IT OUT; 



FALSE 



WRTBLOC 



# 



obc *• tbo; 
streamcp1«-qcda, 

p2*flag(outfibtl63)); % disk address to buffer 
begin si<-l0c pi; ds «- 8 dfc end; 

PCI INX FLAG(OUTFlB[16])*COOTQP3#OUP*OUTFlBtt63»SFB#XCH# 



STD>PRL>DEL>; 
IF CORL«-ORL-OD) > OD 
OCDA <-OCDA + OD 

ELSE 
GETROW; % GET SPACE 

PUDOTOP3); wait; % 



% CALL MCP TO REFILL BUFFER 



THEN 



• 



AND ADDRESS QF NEXT ROW 
WAIT FOR I/O COMPLETE 
COMMENT ON I/O COMPLETE SaVE ORGINIAL I/O DESC, IN FIB* 
OUTFIBC163.C33J153 ♦ CNOT 0) INX NFLAG C* CD0T0P3 )* 

END 

ELSE 
D0TOPfO3 «• 
RTNDWI 

end diskwrite; 

% calculates distribution patterns for 
% merge tapes 

(CTRL MOD TMl) + 1; 



R INX MDOTOPj; 



% POINT AT NEXT RECORD 



SUBROUTINE DIST; 
BEGIN 



CTRL ■ 
FOR I 
BEGIN 



* 1 STEP 1 UNTIL 
TSCI3 ♦ TCC I 3; 
IF I t CTRL THEN 



TMi DO 

TC[M * TCCIJ 



+ TCCCTRL3; 



end; 
end dist; 
subroutine 5elect; 

BEGIN 

x «• cot; % 

COT * COT + 
IF COT * NT 
BEGIN COT <■ 

IF COT = 
PRFIB «■ 
C0I0DC03 
IF COT t 



SA i 



% SELECTS A MERGE TAPE TO WRITE A STRING ON 
INDEX OF PRIOR TAPE 



COIOD «- 
CQI0DC03 



SAVE 

i; 

THEN 

li oist; end; 

CTRL THEN GO TO SAI 

COIODCNQT 231 

«■ FLAGCPRFIBC163); 

X THEN P( C C NOT 2) INx 

20,com#del*ded; 

TP[C0T3 ; 
*• t INX *COI00; 



TPCC0T3) jCCOIQDCNGT 2J], 



end select; 



00724700 


T 


0198*3 


00724800 


T 


0199 J 1 


00724900 


T 


0199*3 


00725000 


T 


020i«0 


00725100 


T 


0203* t 


00725200 


T 


0203*1 


00725300 


T 


0203*1 


00725400 


T 


0205*2 


00725500 


T 


0207*2 


00725600 


T 


0207*3 


00725700 


T 


0207*3 


00725800 


T 


0208*0 


00725900 


T 


0208*0 


00726000 


T 


0208*3 


00726100 


T 


0210*0 


00726200 


T 


0211*3 


00726300 


T 


0212*1 


00726400 


T 


0213*0 


00726500 


T 


0213*2 


00726600 


T 


0214*2 


00726700 


T 


0215*1 


00726800 


T 


0218*0 


00726900 


T 


0219*0 


00727000 


T 


0220*3 


00727100 


T 


0221*2 


00727200 


T 


0222*2 


00727300 


T 


0224*0 


00727400 


T 


0225*0 


00727500 


T 


0225*0 


00727600 


T 


0228*1 


00727700 


T 


0228*1 


00727800 


T 


0228*1 


00727900 


T 


0230*1 


00728000 


T 


0230*1 


00728100 


T 


0230*2 


00728200 


T 


0230*2 


00728300 


T 


0231*0 


00728400 


T 


023110 


00728500 


T 


0232*3 


00728600 


T 


0234*0 


00728700 


T 


0235*2 


00728800 


T 


0239*0 


00728900 


T 


0241*1 


00729000 


T 


024i?2 


00729100 


T 


0242*0 


00729200 


T 


0242*0 


00729300 


T 


0242*3 


00729400 


T 


0244*0 


00729500 


T 


0244*3 


00729600 


T 


0247*0 


00729700 


T 


0248*1 


00729800 


T 


0250*0 


00729900 


T 


0251*1 


00730000 


T 


0255*1 


00730100 


T 


0256*1 


00730200 


T 


0257*3 


00730300 


T 


0259*1 



« * 



€ 



• 



%**********************************% 



SUBROUTINE WRITETAG* 
BEGIN 

IF OBC 
BEGIN 
BUFF * 



• 



END 



STREAM 

BEGIN 

IF NOT 

IF ORl_ 

BUFFCl 

BUFFC2 

BUFFC3 

BUFFU 

AND 
OCDA * 
DOTOPC 
PCI IN 
ONS «• 
SRI «■ 
SR5 *■ 
ORC <• 
PCCODT 
OUTFIB 
WRITETA 



SUBROUTINE 

BEGIN 

BASE * 

IF IRL 
R 



E 
IRLMR 
IF (IB 
VCVLOW 
GO TO 
IBC «■ 
Y <- PC 
STREAM 
BEGIN 
PUITO 
INROWC 
PCCITG 

C 
VCVLOW 
RTNDR' END 

SUBROUTINE 
BEGIN 

IF NO 
IF 



/ TBO THEN 

PCO); OISKWRIT 

FLA6C0UTFIBC1 

S3 

&1 

CP1*L0SA»P2«- 

SI *LQC Pi; DS 

DISKFULL THEN 

< OD + 1 
3 * sri; 

] ♦ orc; 

3 ♦ SRSJ 

] *■ LQSA «• IF 
NOT DISKFULL T 
OCDA + i; 

03 «■ PC. BUFF, L 

x flagc0utfi8c 
ons+i; 

OBI* 

corl*orl-d; 

o; 

oP3); wait; 

C163 * (NOT 0) 

g; 

diskread; 
*[datxcvlqw33 

< THEN 
EGIN VIVL0W3 * 



e; end; 

63) 

0C8 « 38: 103 

£271421631 

EBUFFC033 ); 
*■ 8 DEC FND; % BUFFERC03, 



% WRITE FRONT OF STRING TAG* 
% DEVELOP ADDRESS OF NEXT 
% STRING 
% WRITE OUT BUFFER 

% SET TOP I/O DESCRIPTOR TO 
% 30 WORD* 1 SEGMENT WRITE. 
% DISK ADDRESS OF TAG TO 



THEN GETROW; 



MOREDATA 
HEN OCDA 

OD); 



else 



% GET SPACE F 

% ROW WHERE S 

% RECORDS/STR 

% AMOUNT OF S 

% ROW WHERE S 

% ADDRESS OF 

o; % OR EOF 

% SKIP OVER T 

* WRITE TAG 



163)*CDOTOP3#PRL*DEU; 
% STRING 



OR NEXT ROW 
TRING STSRTED 
ING, 

TRING IN 
TRING STARTED, 
NEXT TAG. 

flag 
ag address, 

N DISK 



COUN' 
SAVE WHERE 
AMOUNT OF Ri 
RECORDS/STR 
WAIT FOR I/I 



TER + 1. 

NEXT ROW STARTS 

OW LEFT 

% RECORDS/STRING *• 0. 

% WAIT FOR I/O COMPLETE 
INX NFLAG(*CD0TQP3); % SAVE IQD IN FIB 



************************•*****% 

% READS DISK ON DISK-TO- 
% DISK MERGE PASSES, 

; % POINT AT CURRENT STRING 

% IF IRL S CALL RECORDS 
IN THIS STRING HAVE BEEN 



nd; 
l-i; 

C*IBC 
] * R 

rtndh 

bf; 

VLOW, 
CP1«-I 

si <• 

PCY33 

hk; 

PCY33 

OMMEN 
3 ♦• V 
DISK 

WRITE 
% S 
T FM 
TM TH 



NFLAG(MHK)&MS 

ciat33»i5"i; 

GO TO RTNDR; * READ 

% 
% 
N BEGIN % 
0W3; % 



-1)X0 THE 
INX VCVL 

end; 



SO POINT 
ING V AT HKl, 
RECOROS LEFT 
IF BUFFER NOT 
THEN INDEX TO 



CORRESPOND 



EXAUSTED 
NEXT RECORD 



DUP'ADD); 
DA*P2>*[I 

loc pi;ds 

'DUP'LOD* 



T0PCY33); 
*8 DEC END; 
XCH*PRL'DEL); 



% BLOCK COUNTER * BLOCKING 

% FACTOR, 

% CONVERT DISK ADDRESS 

% INTO BUFFER. 

% READ NEXT BLOCK 

% GET ADDRESS OF NEXT BLOCK 

% WAIT FOR I/O COMPLETE. 



); wait; 

t point i/o d past disk address; 

cvl0w3&c1 inx c*ut0pcy33 ) ) [ 33* 33 * 15 3 ; 

read; 

out; 

elects fi 
then 
en tapewr 

ELSE 



le to be written during merge 

ite else begin p ( 1 > j diskwrite end 



00730400 


T 


0259*2 


00730500 


T 


0259*2 


00730600 


T 


0260*0 


00730700 


T 


0260*0 


00730800 


T 


0260*3 


00730900 


T 


0263*0 


00731000 


T 


0263*1 


00731100 


T 


0264*0 


00731200 


T 


0266*1 


00731300 


T 


0267*2 


00731400 


T 


0268*1 


00731500 


T 


0268*3 


00731600 


T 


0272*0 


00731700 


T 


0273*1 


00731800 


T 


0274*2 


00731900 


T 


0275*3 


00732000 


T 


0275*3 


00732100 


T 


0276*1 


00732200 


T 


0279*3 


00732300 


T 


0281*0 


00732400 


T 


0282*0 


00732500 


T 


0284*1 


00732600 


T 


0285*2 


00732700 


T 


0286*1 


00732800 


T 


0288*0 


00732900 


T 


0288*3 


00733000 


T 


0290*0 


00733100 


T 


0292*2 


00733200 


T 


0292*3 


00733300 


T 


0292*3 


00733400 


T 


0293*0 


00733500 


T 


0293*0 


00733600 


T 


0294*1 


00733700 


T 


0295*1 


00733800 


T 


0297*0 


00733900 


T 


0298*0 


00734000 


T 


0298*2 


00734100 


T 


0298*2 


00734200 


T 


0300*2 


00734300 


T 


0303*2 


00734400 


T 


0305*2 


00734500 


T 


0306*0 


00734600 


T 


0307*1 


00734700 


T 


0308*2 


00734800 


T 


0310*1 


00734900 


T 


0311*0 


00735000 


T 


0313*0 


00735100 


T 


0314*0 


00735400 


T 


0316*0 


00735500 


T 


0316*0 


0®735600 


T 


0319*0 


00735700 


T 


0319*1 


00735800 


T 


0319*1 


00735900 


T 


0320*0 


00736000 


T 


0320*0 


00736100 


T 


0320*2 


00736200 


T 


0325*0 



41 



begin comment call output procedure or write intrinsic; 
outcount * outcount +u. 
if gptog Then 

BEGIN 

if ac then 
begin enoq <■ oj if ac»[46?13 then 

p(mks»blngo»0*perfdrmgen) % c0b0l68 
else pcmks*bingo,cprtbasecpcdup)3 3#lod#ipfidx»cqc) 
end else pcmks,0,*[qutfil]>q#outpro)j 

END 

ELSE 

begin comment output file rather than output procedure* 
if ac then p(mks,0, 1*1*0, r,[dutfil3*1*c0rw3 
else begin 

pcmks,i*o*o*r,coutfil3*alwr); 

PCMKS*1*0*0*(-R)*[OUTFIL3*ALWR*DED; END* 

if df then if p then p ( 1 , coutf ile not 233 * 83* 17* com) j 

end; 

end; 
end writeout; 



SUBROUTINE 
BEGIN 
FOR I «• 
BEGIN 
IF EOF THEN BEGIN 



A 



SUBMERGE; X SETS UP DISK INPUT TO START 
STEP 1 UNTIL CMS-1) DO 



MERGE PASS 



VCI3 «• NFLAGCMHK)&MStl8l33»i5]J 
P(0»*CDATXCI]]#1»CDC»STD)I % IRL * 

END 

ELSE 
BEGIN 

BASE * *CDATX[I33; * POINT AT CONTROL INFO 
Y «• PCUDUPMDD); % Y * 2x1 
BUFF «■ *CITOP[YJ3; 

COMMENT SET I/O D = 30 WORD* 1 SEGMENT READ; 
IT0PLY3 «■ C*[ITOP[Y33)&30f8838!103« ( lC27t42S63; 

COMMENT PUT ADDRESS OF STRING TAG WORD IN BUFFERCO)* 
STREAM (PI* ( IDA*LlSA)*P2**UT0Pm3); 

BEGIN SI * LOC Pi; DS * 8 DEC END* 
PC,BUFF,LQD* CITOPCY]]*PRL*DEl); % READ TAG TO BUFFER 2 
COMMENT READ 1ST DATA RECORD TO BUFFER #2* TAG GETS 
ROTATED TO BUFFER #1J 
P(CITOP[Y33); WAIT* % WAIT FOR I/O COMPLETE 



STREAM(P1«-C IDA«-IDA +1 ) ,P2** [ I TOPt Y 3 3 } ; 

BEGIN SI «• LOC Pi; DS * 8 DEC END/* 

P(*tITOPn33*CITOPCY33*PRL*DEU); % REAO 

pccitopey33); wait* % wait for i/o on 
buff <- *citopcy33; 

ibc «■ bf; 

IRC «■ buffcu; 

IRL <- BUFFC23 - 1* 
ISL * <BUFF[33 DIV OD) x (00 
IF (LISA <• BUFFC43) < THEN 
INROWCHk; % GET ADDRESS OF 
STREAM(P1*IDA *P2«-[BUFFC033); 

BEGIN SI+LOC Pi; DS «■ 8 DEC END; 
P(,8UFF,LOO*CITOPCY33*PRL,DEL3; % READ 



% BLOCK #1 ADDRESS 

BLOCK #1 
READING TAG 



DIV Oil 

eof «- true; 

BLOCK #2 



BLOCK #2 



00736300 
00736400 
00736500 
00736600 
00736700 
00736800 
00736850 
00736900 
00737000 
00737100 
00737200 
00737300 
00737400 
00737500 
00737600 
00737700 
00737800 
00737900 
00738000 
00738100 
00738200 
00738300 
00738400 
00738500 
00738600 
00738700 
00738800 
00738900 
00739000 
00739100 
00739200 
00739300 
00739400 

00739500 
00739600 
00739700 
00739800 
00739900 
00740000 
00740100 
00740200 
00740300 
00740400 
00740500 
00740600 
00740700 
00740800 
00740900 
00741000 
00741100 
00741200 
00741300 
00741400 
00741500 
00741600 
00741700 
00741800 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0325 
0325 
0326 
0327 
0327 
0327 
0330 
0331 
0333 
0335 
0335 
0335 
0336 
0339 
0339 
0341 
0343 
0347 
0347 
0347 
0347 
0347 
0348 
0348 
0352 
0352 
353 
0355 
0357 

0357 
0357 
0357 
0358 

0360 
0361 
0361 
0365 
0365 
0367 
0368 
0370 
0370 
0370 
0372 

0375 
0376 
0378 
0380 
381 

0382 
O384 

0386 
0389 
0391 
0393 
0394 
0395 



1 

€ 






j» * 



a * 



• 



INRQWCHKJ % GET ADDRESS Of BLOCK #3 

PilUQPnU)} WAIT; % WAIT FOR I/O COMPLETE ON BLOCK #1 

vci3 * nflagcc1 inx * [ i tqpc y 3 3 )&i ci 8 * 33 * 15 ) ) ; 

end; 
end; 
end submerge; 

SUBROUTINE FIRSTSELECT; % INITIAL SELECTION OF LOW RECORD 
BEGIN 

X <- 0; l*MS-i; 
DO BEGIN 

i*i+i; 

VCI3 «■ VCX + C C IF ALFA THEM P C 0# mKS# 0* VX 1 # VX, EQUALS ) 
ELSE IF AC THEN PC0# MKS# VX1 # VX*EQUALS ) 
ELSE P(MKS#VAi,o*VA,0. EQUALS}) AND TRUE)]; 
END UNTIL (X«-X + 2) s STPP; VlOW «• V [ I ] , [ 18 * 153 ; 

end firstselect; 
subroutine lowselect; 

BEGIN 

X * VLOW AND 1022; 

DO BEGIN 

I «- MS + X.C38I9]; % l ] MS + CX/2) 

vci] ♦• v[x + ((if alfa then p( 0* mks#0# vxl ,vx, equals ) 
else if ac then pcq,mk5#vxi#vx*equal5) 
else p(mks#va1»0*va#0»equals)) and true)); 

X * I AND 1022; 

END UNTIL I = STPPJ VLOW * VC I 3 , U8 * 153 ; 



END LOWSELECT? 
SORT IT; 



£*********************************£ 
% DEVELOPS STRINGS FROM INPUT TAPE 



SUBROUTINE 
BEGIN 
COMMENT USE SPECIAL SORT COMMUNICATE TO GET STORAGE FOR 

DATA AND VECTOR ARRAYS; 
PC R»S+1#[0ATN] #21 »COM*DEL* DEL»OEL); 
PCMKS, CVN 3 * C2xS)M#l#l# 1# BLOCK}; 
STPP *• P(MS*S#DUP#A0D#2'SUB); 

COMMENT CALL HIVALU TO SET UP HK1 ROW OF DATA; 
STREAM(A«.*[DaTX[S3],B*R*1*C*PCdUP},[36»63)* 

begin di<-a;si«.loc c;ds*wds; 

si«-a;c(os*32 wds;ds<-32 wdS);ds«-b wds; 
end; 

P(MKS»*[DATX[S33); if not AC 

COMMENT INITIAL FILL OF DATA 

IF TR £ THEN 

BEGIN COMMENT NOT 1 ST CALL ON SORT SO FILL DATA FROM 
OUTFIBC 133 • C27: 13 * l; % SET FILE TO 

PUDQT0P],O,H#C0M#DEL*DEL); % OPEN DISK FILE 
PCCD0T0P3); WAITJ % SLEEP UNTIL FILE IS OPENED 
OCDA «• 0UTHEADC103 + P COD, DUP» ADD ) ; 
I * O; ORL * ORS; 08C * Tbo; 

while i < s do 

BEGIN 

IF I < TR THEN 

BEGIN;COMMENT MOVE RECORD TO DATA; 

STREAMCPl**CDOTOP3»P2«-R#P3«-CPCDUP)).C36J63f 
P4«-*[0ATX[I]]}; 

BEGIN SI«-Pi;P3CDS<-32 WDS;DS*32 WDS); DS*P2 WDS END; 



THEN PCO#RDS#CFX#0); PCHIVALU); 
ARRAY FROM INPUT SOURCE; 



disk; 

READ 



0Q741900 
00742000 
00742100 

00742200 

00742300 

00742400 

00742500 

0S742600 

00742700 

00742800 

00742900 

00743000 

00743100 

00743200 

00743300 

00743400 

00743500 

00743600 

00743700 

0©743800 

00743900 

00744000 

00744100 

00744200 

00744300 

00744400 

00744500 

00744600 

00744700 

00744800 

00744900 

00745000 

00745100 

00745200 

00745300 

00745400 

00745500 

00745600 

00745700 

00745800 

00745900 

00746000 

00746100 

00746200 

00746300 

00746400 

00746500 

00746600 

00746700 

00746800 

00746900 

00747000 

00747100 

00747200 

00747300 

00747400 

00747500 



T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



397*0 

0398*0 

0400*0 

0403*0 

0403*0 

0403*2 

0403*3 

0403*3 

0404*0 

0404*0 

0406*0 

0406*0 

0407*1 

0411*2 

0415*2 

0422*3 

0426*3 

0427*0 

0427*0 

0427*0 

0428*1 

0428*1 

0430*0 

0434*1 

0438*1 

0445*2 

0446*3 

044gj3 

0450*0 

0450*0 

0450*0 

0450*0 

0450*0 

0450*0 

0452*2 

0455*1 

0457*2 

0457*2 

0460*1 

0461*0 

0463*0 

0463*1 

0466*3 

0466*3 

0467*2 

0468*0 

0470*2 
04 72*0 
0473*0 
0475*0 
0477*2 
0478*3 
0478*3 
0479*2 
0480*0 
0481*3 
0482*3 






• 



PC 1 3 * DISKWRITE' 

Vt II <• NFLAGC(*CDATXtI]])«IC18l33ll53)i 

END 

ELSE V[I3 * NFLAGCC*CDATXtS]3)43tl8«33ll534l[5l47H])l 
I * 1*1* 

end; 

p<mks,0,0»edqtap[nqt 233*4, fcr>; % rewind 
outfibc 1 3 d , c27 : 1 3 * 0) % set to output 
pudotop]*(m1,com#del#del)* % open file output 
pccDOToptmii wait; 
go to tpb; 

end fill of data from disk; 

if iptog or ac then begin inread; incount * end* 

for vlow <- step 1 until s-l do 

BEGIN COMMENT FILL DATA FROM InPUT FILE; 

IF VLOW t THEN INREAO; % POINT AT NEXT RECORD 

IF NOT EOF THEN 

BEGIN; COMMENT MOVE RECORD FROM FROM BUFFER TO DATA[VLOW#03; 
STREAM<Pl«-*CCIiaD3'P2<-R,P3«-PCDUP),C36J63» 

P4* *CDATXCVLOW33); 

begin si ♦ pi; p3c ds*32wds; 0so2wds ) ; ds*p2 wds end; 
vtvlow] «• nflag((*cdatx[vlow33)&vlqwc18:33si53); 
end; 

end initial fill loop; 
ipb: ori «■ 10; getrow; 

IF DISKFULL THEN P( 1 , CDOTOPCNOt 23 3 > 81, 17, COM ); 
OCDA <- CLOSA «• OUTHEADEORI3) + 1J 
SRS*DRL*ORS-U SRl*ORU ONS*GRC<-0; 0BC*T80; 
IPBAS firstselect; % INITIAL COMPARE 

go to ipd; 
ipc: lowselect; % interm compare 
ipd s if vlow < ms then 

begin;comment move next record to output area; 

streamcpl«-vl,p2*r,p3*cpcdup)>.[36l6],p4**[dqt0p3)j 

BEGIN SI«-PliP3CDS*32WDS;0S*32WDS)IDS«-P2 WDS ENo; 

pen; diskwrite; * WRITE on disk the record FROM DATAFLOW, 03 

INREAD; % POINT AT NEXT RECORD 

IF NOT EOF THEN 

BEGIN COMMENT CHECK IF NEXT RECORD IS SMALLER; 

IF < IF ALFA THEN P(0>MKS,0> * I INFIL3 t VL*E<3UALS } 

ELSE IF AC THEN P CCMKS* *t C HOD 3 >VL> EQUALS ) 
ELSE P<MKS*XAL#0*VAL>0>EQUALS)) 
THEN VCVLOW] * NFLAG C ( * CDATX CMS3 3 )&MS [18 * 33 J 15 3 )i 
STREAM(Pl^*CCliaD3*P2*R*P3«-P(DuP).C36l63*P4«"*tDATXCVLOW3 3); 
BEGIN SI«-P1;P3CDS*32WDS;dS*32WdS)JDS*P2 WDS END; 

% move next record to data 
end; 

if not diskfull then 60 to ipc; 
end; 

comment end of stringing pass or no 
if not diskfull then % check for record 

FOR I ♦ STEP 1 UNTIL MS*1 DO 

if cvlow * vcn,Eieii5i) < ms then go 
moredata «• false; 
for i* step 1 until ms-m do 
tf not vu],c5*13 then 

BEGIN V C 1 3 «• NFLAG(C*CDATxCI33)&IC18J33:i53); 



more data; 

* HIGH KEY 

TO ipd; 



00747600 
00747700 

00747800 
00747900 
00748000 
00748100 
00748200 
00748300 
00748400 
00748500 
00748600 
00748700 
00748800 
00748900 
00749000 
00749100 

00749200 

00749300 

00749400 

00749500 

00749600 

00749700 

00749800 

00749900 

00750000 

00750100 

00750200 

00750300 

00750400 

00750500 

00750600 

00750700 

00750800 

00750900 

00751000 

00751100 

00751200 

00751300 

00751400 

00751500 

00751600 

00751700 

00751800 

00751900 

00752000 

00752100 

00752200 

00752300 

00752400 

00752500 

00752600 

00752700 

00752800 

00752900 

00753000 

00753100 

00753200 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0485*0 
0486»0 

0488«2 
0488*2 
0492*2 
0493«3 
049411 

0498*0 

0500*2 

0502*0 

0504 10 

0504*2 

0504*2 

0507*3 

0512*0 

0512*0 

0514*0 

0514*2 

0515*0 

0516*3 

0517*3 

0520*0 

0522*2 

0522*2 

0523*0 

0525*0 

0527*3 

0529*3 

0534*2 

0536*0 

0536*2 

0538*0 

0538*3 

0539*1 

0542*0 

0544*1 

0546*0 

0547*0 

0547*2 

0548*0 

0550*3 

0554*0 

0559*0 

0562*0 

0564*3 

0367*0 

0567*0 

0567*0 

0567*3 

0567*3 

0567*3 

0568*1 

0573*0 

0576*1 

0577*0 

0581*1 

0582*2 



* p 



» ' 



IPE. 






IPG::END SORTIT* 



MOREDATA «• TRUE END; 
DISKFULL «• TM AND GNS > MM OR DISKFULL* 
WRITETAg; % WRITE STRING TAG WORD IN FRONT OF STRING 
IF DISKFULL THEN GO TO IPg* 
IF MOREDATA THEN 

IF NOT TM OR ONS < M THEN GO TO IPBA 
ELSE GO TO IPgJ 
FM «• NOT TM AND ONS < M* 



SUBROUTINE 
BEGIN 



MERGEIT* % MERGES M STRINGS TO 1 STRING 



}W RECORD TO OUTPUT FILE 
»2«.R,P3*CP<0UP>>.C36»6]»P4**[C0I0DJ); 

J<0S*32W0SJDS*32WDS)IDS* P2 WDS END; 
;rfah* 



mic s firstselect; 

go to miej 
mids lqwselect; 

MIEx IF VUOW < MS THEN 

BEGINJ % MOVE LOW RECORD TO OUTPUT FILE 
STREAM(P1«-VL.P; 
BEGIN Sl*pi;p3.,_ 

writeout; diskread; 
go to mid; 

end; 
for i * step 1 until ms-1 do % check for record 

IF CVLOW «■ V[I3.tl8*l51) < MS THEN GO TO MIE* 
IF NOT TM AND NOT EOF THEN 

BEGIN COMMENT HAVE MERGED M STRINGS FROM INPUT! 

TO ONE STRING IN OUTPUT* SELECT 
MORE STRINGS TQ MERGE 



* HIGH KEY 



M 



end mergeit; 



writetag; 
submerge; 

GO TO MIC* 

end; 

* initialize SORT PASS 

(cac «■ r>0) or mf)* r «■ abscr); 

% identify cqbol68 



STARTJ % 

BLKCTR ♦ BLKCTR + . . 

IF AC THEN IF CORES IZE , C 1 J 1 3 .m... « * 
BEGIN AC*3* C0RESIZE«-A8S(C0RESIZE); 



THEN 



IF NOT 



BLKCTR 

end; 
qptqg then 



*■ BLKCTR - 1 



BEGIN 



PRFI8 
IF R > 






OUTFlLtNOT 21; 
CPRFIBC 181 . C33: 15 3 ) THEN 
PClf COUTFILCNOT 233*87*17, COM); 



P(MKS,[TSN3*CTCN3*[TNN3* 8 ,l,s, 
-- MF THEN GO TO P( POLYMeRGE ) ; 



IF 
LISA 



LISA <- IF IPTOG THEN ELSE % SIZE 
2xPC*[INFILCN0T 2 3 3 * 18* COC ) , [ 3*153 * 
CORESIZE ♦ (IF CQRESIZE ' THEN 12000 
• snnn m i tsa: 



3,1. BLOCK); 
ELSE X SIZE OF INPUT BUFFER 



LYS 



IF 

ONS *• R 
WHILE ONS < 
IF ONS > 1023 
IF ONS MOD 



COMMENT 
LZ* ORC * ONS* 



IF IPTOG 

233*18, COC). £38153* 

ELSE CORESIZE) 
- 2000 • LISA* 
CORESIZE < 2500 THEN CORESIZE * 2500* 
«- ABS(R); S * M * 512* 
30 DO ONS <• ONS + R* 
THEN BEGIN ONS * ONS 

30 x o then begin ons * 



ONS NOW MINIMUM 



- R* GO 
ONS + R* 
BUFFER SIZE* 



TO LZ END* 
GO TO LY END* 



00753300 
00753400 

00753500 
00753600 
00753700 
00753800 
00753900 
00754000 
00754100 
00754200 
00754300 
00754400 
00754500 
00754600 
00754700 
00754800 
00754900 
00755000 
00755100 
00755200 
00755300 
00755400 
00755500 
00755600 
00755700 
00755800 
00755900 
00756000 
00756100 
00756200 
00756300 
00756400 
00756500 
00756600 
00756610 
00756620 

00756630 
00756650 

00756700 
00756710 
00756720 
00756730 
00756740 

00756750 
00756800 
00756900 
00757000 
00757100 
00757200 
00757300 
00757310 
00757400 
00757500 
00757600 
00757700 
00757800 
00757900 



0585*2 
0586*3 

0589*2 

059110 

0592*0 
059 2 !i 

0594*1 
0595*1 
0597*1 
0598*1 
0598*1 
0599*0 
0599*0 
0600*0 
0600*2 
0602*0 
0602*3 
0603*1 
0606*0 
0608*1 
0610*0 
0610*2 
0610*2 
0614*3 
0618*0 
0619*1 
0619*3 
0621*0 
0622*0 
0622*2 
0622*2 
0622*3 
0622*3 
0635*2 
0639*1 
0640* 3 
0643*0 
0644* 1 
0644*1 
0644*3 
0645*1 
0647*0 
0648*2 

0651*0 
065i*0 

0653*1 
0656*3 
0658*1 
066112 
0663*2 
0665*1 
0667*1 
0670*0 
0676*0 
0679*0 
0682*2 
0682*2 



c 



• 
• 



LXS 



• 



WHILE ( 
ORL * 
WHILE C 
OCDA ♦ 
LQSA «- 

IF LGSA 
LOSA * 

IF LOSA 

SRS ♦ 
ORI <- 2 
IF ORI 
BEGIN 
SR 
OR 
OR 
GO 
ENDi 
♦ SRI 
BF *■ SR 
CO 
DISKSIZ 



ORC 
RCi 
ORC + 
CORESi 
CQCDA- 

< 2 T 

(OCDA- 

< 2 T 
RL>" SR 
xORL + 
< l.lx 

S «• OR 

C *• §R 

L ♦ OR 

TO LX 

DIV 3 
I DIV 

MMENT 
E * C 



+ ONS) < 150 DO ORC «■ ORC + ONS ; *DSK INPT BUFF SZ 



ORL) < 450 DO ORL * ORL + ORC J *DSK OTPT BUFF SZ 

ZE - 2xORL> 

R) DIV C2X0RC); 

HEN M * 2 ELSE WHILE M > LOSA DO M*M DIV 21 

R) DIV (R+3)l 

HEN S * 2 ELSE WHILE S > LOSA DO S*S DIV 2) 

i <• orc; 

CORESIZE AND ORC < 1023 THEN 

l; SRI * ORCJ 

C + ONS; 

CI WHILE ORL < 300 DO ORL * ORL + QRCJ 



THEN D «■ D + i; 



IF DISKSIZE < 
DISKSIZE 
WHILE (D 

OD «• D x V ' 
COMMENT SET UP OIS 

OUTFIB *■ *CDOTOP[N 
OUTFIBt 83 * (DISK 
OUTFIBC133.C J0;9] 

0UTBIB[«J.C7»n * 
OUTFIBC183 * (X*TB 
IF (Y<-OUTFIB[43,tl 
OUTFIBC43 * OUTF 
IF FPBCFNUM+33.C16 
FPBCFNUM+33.C16 
COMMENT OPEN DISK 

WILL POINT 

P(CD0T0P3»0»11'C0M 

OUTHEAO * *C0UTFI8 

IF NT > 2 THEN 

0UTHEAD[8]«-QUTHEAD 

COMMENT GET D 

PCCDOTOPCU]); WAI 

ORI «• 9i GETROWi M 

IF DlSKFULL THEN 

PC1>[D0T0P[N0T 233 

COMMENT IF INPUT F 

INITILIZE LIN 

IF IPTOG THEN BEGI 

BEGIN ENDQ «- 

PCMK5* riNFlL 

IFCAC AND 33 

BEGIN C 

W 

END END ELSE 

BEGIN COMMENT 



Of IF SRI MOD 30/0 

r; TBO * SRS DIV r! 

COMPUTE DISK ROW SIZE* * ROWS 

IF QISKSIZE « THEN 1000x600 

/ (BFxl9xR){ 

CY * TBO DIV BF) THEN 

* Y + Y ELSE 
ISKSIZE MOD Y)/0 DO DISKS 1ZE«-DISKS IZE 



ALWAYS ■ 201 
ELSE DISKSIZE) 



* i; 



K OUTPUT FILE AS ALGOL FILE* 

OT 233; % GET FIB DESCRIPTOR 

SIZE DIV Y)&20C15*38U03J % # ROWS, ROW SIZE, 

* OUTFIBC 133.C1 893; 

((AC AND 3) = 1)J %C08QL6l DISK SORT FLG 

0xR)&Xf3;33t.t53&Xtl8J33:i53; % DISK BLOCK 

2*123 3 < 1023 THEN % FILE # TO FILE INDEX 

IB[43&(CY-l)xETRLNG)U3*37:il3&U12 5 47U3; 

$73 ■ THEN % NOT LABEL EQUATED 

*23 ?= l; % USE FAST DISK 

OUTPUT FILE* WILL SET UP FIBC163 AND 

TOP I/O DESc, PAST DISK ADDRESS; 
/DELUDED; 
C1433; 

[83 OR mem; 

ISK SPACE FOR 1 ROW; 

T; % WAIT FOR FILE TO BE OPENED 

OREDATA ♦ TR * *\l 

,B\>\7* COM); % IOR 81 

ILE THEN OPEN IT* IF PROCEDURE THEN 

KAGE TO CALL IT; 

N IF AC THEN 

0; BINGO * INPROJ END; 
3*R* J*1*1*BL0CK); 
■ 3 THEN % C0BOL68 
HOD «■ CWAIN3; 
AIN «• PCCINFIL3#DUP*L0D*0*CDC*DEL*LQ0); 

CHECK FOR ALGOL OR COBOL; 



00758000 
00758100 
00758200 
00758300 
00758400 
00758500 
00758600 
00758700 
00758800 
00758900 
00759000 

00759100 
00759200 
00759300 
00759400 
00759500 
00759600 
00759700 
00759800 
00759900 
00760000 
00760100 
00760200 
00760300 
00760400 
00760500 
00760600 
00760700 
00760800 
00760900 
00761000 
00761100 
00761200 
00761300 
00761310 
00761320 
00761400 
00761500 
00761600 
00761700 
00761800 
00761900 
00762000 
00762100 
00762200 
00762300 
00762400 
00762500 
00762600 
00762700 
00762800 
0§763000 
00763050 
00763100 
00763150 
00763200 
00763300 



0683*1 
0686*3 
0687*2 
0691 JO 
0692*3 
069510 
0700*2 
0702*3 
070811 

07091-3 

0712»2 

0714«3 
0715H 
0716*3 
0718?0 

0723*0 
0723*2 
0723*2 
0727*3 
0730*1 
0730*1 
0732 IS 
0735*0 
0736*3 
0738*2 
0742*2 
0743*3 
0743*3 
0745*2 
0748*1 
075i*2 
0755*0 
0758*3 
0760*3 
0765*3 
0768*2 
0772*3 
0772*3 
0772*3 
0774*1 
0775*2 
0776*1 
0778*3 
0778*3 
0781*0 
0784*2 
0784*3 
0787*1 
0787*1 
0787*1 
0788*1 
0790* 3 
0792*2 
0793*3 
0795*0 
0797*1 
0797*1 



* * 



* 

# 
• 



if ac then begin pcmks*cnot 2) inx c infil ] * 1 *cqfcr ) ; 
if ac. c46i 13 then % cdb0l68 
begin ciiod «■ cwain3i 

wain * p<*cinfilcn0t 233 * 20, coc* 0* xch* fcx* 
oup,dib 0*lod*0*cdc*del*dib g*lgd>; 
end end else begin % open algol input file 

PRFIB * *CINFlLtNOT 23 3i 
PRFIBC13], [27*13 * U 
PCMKS*0*3*[INfIL3*ALRD*DEL); 

end; 



end; 

IFCAC AND 
CALLSORT? 

sortit; 



3)*3 THEN CIIOD <• CINFIU3J 



% 



ENBSORTPASS: 



AND 



• 



CONTENTS OF 
OUTHEAOtORl 

* ors; 



13 then 



DATA ON DISK; 

* 103; i * o; 



sort input file into strings 

COMMENT TURN BACK WHaTS NO LONGER NEEDED 
INITILIZE MERGE PASS; 
IF EOF THEN COMMENT CLOSE INPUT TAPE; 

IF NOT MOREDATA THEN 
BEGIN 

if iptog then pc [ inf il 3 * 3, com* del ) 
else p(mks,2,@»cinfilen0t 233* 

if (infil = qutfil) and ac then 18 else «#fc-r)j 
if incount a then p c 1 * [ dotqp cnot 23 3 #86* 1?* com) ; 
end; 

IF MOREDATA THEN 
BEGIN COMMENT SAVE 
TR «• O; QCDA <• 
OBC «• tbo; ORL 
WHILE I < S DO 
BEGIN 

IF NOT vm»C5l 
BEGIN 

TR «• TR +i; 

STREAM(Pi < .*[0ATXCI]3,P2«-R*P3*(P(DUP)).[36?63* 

P4«-*[DOTOP3); 

begin si«-pi;p3(0s<-32wds;ds*32wds);ds*p2 wos end* 
pcd; diskwrite; 
end; 

i*i+i* 

end; 

pco; diskwrite; % write block 
end; 

AC * AC4EOFC2l47Ul«M0RE0ATACljft7U]J 

COMMENT TURN BACK DATA S VECTOR ARRAYS; 

PC ,DATA#lOD*RFB* ,DATA*STD* CDATn3,22*COM*DEL)*' 

P(.V*L0D*RFB* «V*STD*CVN3*3 J iCOM*DEL); 

stpp * PCMS *■ M*DUP»ADD*2*SUB); 

BLKCTR ♦• BLKCTR + U 

COMMENT DECLARE DISK OUTPUT FILE; 

ITNK * 0* 

PCMKS,20*DlSKSIZE*3*0UTFlB[4].tl3J113DlV ETRLNG +2*CQKn, 
(Y«-2xM),l,BFxR,0,0, 10* 8* BLOCK); 

INFIB «• *CITMKC233; 

ITOP * [ITNKC533&Y[8*38! 103 ; % POINT ITOP AT TOP I/O 
COMMENT OPEN FILE? 

PC[ITNKC53 3*0*11*CQM,DEL,DEL); 



00763400 T 079713. 



00763440 

00763450 

00763460 

00763470 

00763500 

00763600 

00763700 

00763800 

00764200 

00764300 

00764350 

00764400 

00764500 

00764600 

00764700 

00764800 

00764900 

00764950 

00765000 

00765100 

00765200 

00765210 

00765300 

00765400 

00765500 

00765600 

00765700 

00765800 

0S765900 

00766000 

00766100 

00766200 

00766300 

00766400 

00766500 

00766600 

00766700 

0Q766800 

00766900 

00767000 

00767100 

00767200 

00767300 

00767400 

00767500 

0076760Q 

00767700 

00767800 

00767900 

00768000 
00768100 
00768200 
00768300 
00768400 
00768500 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

P 

C 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0800»1 
080i*0 
0802*1 
0804*3 
0807*1 

0807*3 
0809*2 
0812*0 
0813*2 
0813*2 
0813*2 
0816*0 
0816*0 
0817*0 
0817*0 
0817*0 
0817*0 
0817*1 
0818*1 
0818*3 
0820*2 
0822*3 
0827*1 
0830*2 
0830*2 
0830*3 
083U1 

0834*1 

0836*0 

0837*1 

0837*1 

0838*2 

0839*0 

0840*1 

0842*1 

0843*0 

0845*1 

0847*0 

0847*0 

0848*1 

0848*3 

0830*0 

0850*0 

0852*3 

0852*3 

0855*0 

0857*1 

0859*2 

0860*3 

0860*3 

086i*2 

0864*3 

0868*1 

0869*2 

0871*2 



00168600 T 0871*2 



DKC* 



DKD? 



DKE 



DKF 



TPA* 



TPB 



TPC8 



DISK 
OPENED 



ROW 



INHEAD «• *[INFIBC1433* 
IF MT > 2 THEN 

INHEADC8] *■ INHEA0[8]«lC2U7in; % FLAG SORT 

PUITQPCY«.Y-13])J WAIT; % WAIT FOR FILE TO BE 

IF INHEADCIO] *0 THEN 

PCI®*, INHEAD, LOO, 24, COM*DEL*DEL ) * % RETURN 1 ST 

COMMENT SET FILE TO READ & PERMUTE 2 BUFFERS* 
INFI8C 133 «■ INFIB[13]&2Cl0l39:9j&lC27t47ll3J 
INFIBC16] * C*CINFIB[16J3)*lC2ftU7H]J 

COMMENT GET DATA AND VECTOR ARRAYS* 
P C MK S. [ VN] #(2)cM)-l, 1,1,1, BLOCK )1 
PC5,M+l,[DATN3,2l,COM,DEL*DEL*DEL)* 

COMMENT GENERATE HIGH KEY RECORD* 
MHN * 0* PCMk5,CMHN3*R*1,1,1,8lQCK)* 
P(MKS,MHK)* IF NOT AC THEN PC O'CDC* MHK* XCH*RDS, CFX,0 ) * 

p (HIV ALU )* 
FOR I <- STEP 1 UNTIL Y DO 

ITOPCU * CNOT 0) INX ( * C ITOPC 1 3 3 ) &1C 24 * 47 J 1 1*0C 27 *42* 6 J * 
IF NOT TM THEN 

BEGIN % DISK ONLY SORT COMPLETED 
IF FM THEN GO TO DKF* 

P(10,*0yTHEAD»L0D>24,CQM,DEL,DEL)* % RETURN OVERLAY SPACE 
PC, INHEAD* LOD,,OUTHEAD, LCD,, INHE AD, STD,,OUTHEAD»STD)* 



ORI* ORI * 
ORI < SRI 



10* 
DO 



% 



SRI* AMOUNT OF DISK USED TO NOW 
% GET ANOTHER AREA OF DISK « SRI 



FORGETDISK* GO TO TPA* END* 



* ORI * 11)3) + 1* 



GO TO TPC END* 



SRI * 
WHILE 
8EGIN 

GETROW* 

IF DISKFULL then 
BEGIN PC.0UTHEAD,LOD)* 
END* 

COIOD «■ DOTOP* 
OCDA «• (LOSA * OUTHEADCCSRI 

SRS «• ORL ♦ ORS * 1* 

LISA <• INHEADCH3* % LOCATION OF FIRST TAG 

MOREDATA «■ NOTCEOF <- DISKFULL <- ONS «- 0)* 

SUBMERGE* MERGEIT* 

IF FM THEN BEGIN P C * C I NF I 8 CI a 3 3 ) * FORGETDISK* 

MOREDATA <- FALSE* WRITETAG* 

PC.INHEAD,LOD*.OUTHEAD*LOD,,INhEAD*STD*.OUTHEAD,STD)* 

IF ONS > M THEN GO TO DKD* 

FM <* TRUE* MS * 2* WHILE ONS > MS DO MS*MSx2* 

STPP <• 2xMS-2* 

COMMENT REPLACE DISK OUTPUT BY 
PCMKS,0*0, CDOTOPCNOT 233*4, FCR)* % 
OPENOUT* IF(AC AND 3)*3 THEN COIOD 
GO TO DKE* 
END* 

COMMENT DISK^TAPE MERGE* 
PC.lNHEAD,LQD*,OUTHEAD,LOD,,INHEADiSTO*,OUTHEAD,STD)* 
PCMKS,0,0,[DaTQP[NOT 233,4,FCR)* % RETURN BUFFERS 
LISA <■ INHEADC113* MOREDATA ♦• nOTC E0F*DISKFULL*0NS*0 )* 
IF TNCC0T3 > TC[C0T3 THEN BEGIN SELECT* GO TO TPB END* 
SUBMERGE* MERGEIT* WR 1TEST0PPER* 
IF NOT EOF THEN GO TO TPB* 

PC . INHEAD, LOD,,OUTHE AD, LOD,. INHEAD* STD/.OUTHE AD, STD)* 
PC,DATA,LOD*RFB, .DAT A* STD* C DATN3 *22, COM, DEL ) * % RTN DATA 
INHEAD * INFIB «■ BASE * ITQP ♦■ BUFF «■ 0* 



PROGRAMMERS OUTPUT* 
RETURN BUFFERS 
*• C0UTFIL3* 



00768700 
00768800 
00f68900 
00769000 
00769100 
00769200 
00769300 
00769400 
00769500 
06769600 
00769700 
00769800 
00769900 
00770000 
00770100 
00770120 
00770200 
00770300 
00770400 
00770500 
00770600 
00770700 
00770800 
00770900 
00771000 
00771100 
00771200 
00771300 
00771400 
00771500 
00771600 
00771700 

00771800 
00771900 
00772000 
00772100 
00772200 
00772300 
00772400 
00772500 
00772600 
00772700 
00772800 
007729Q0 
00773000 
00773100 
00773200 
00773300 
00773400 
00773500 
00773600 
00773700 
00773800 
00773900 
00774000 
00774100 
00774300 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 

T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0873H 
0874*2 
0875«1 
0878*1 
088l»0 
0882*0 
0884*1 
0884*1 
088713 

0890*2 

0890*2 

08931 1 

0895*3 

0895*3 

0898*1 

0902*1 

0902*2 

0904*0 

0910*3 

0911*1 

091113 

0912*3 

0914*2 

0916*2 

0918*0 

0919*1 

0919*1 

0920*0 

0920*1 

0922*2 

0923*0 

0923*3 

0926*3 

0928*3 

0929*3 

0932*1 

0934*0 

0937*2 

0939*0 

0941*0 

0942*1 

0946*3 

0948*2 

0948*2 

0952*1 

0955*2 

0956*0 

0956*0 

0956*0 

0958*0 

0961*3 

0965*1 

0968*2 

0972*0 

0972*3 

0974*3 

0977*0 



# 



• 
• 



IF FM OR AC. [112] »1 THEN GO TO WRAPUP; 

P. (10, COM); XRETURN MERGE MATRIX XTR-U7 

MOREDATA «- ACJHUJ EOF «• AC. 12*13* 

go to callsort; 

WRAPUP! 

pc*coutfibch]]>; forgetdisk; 
outfib *• outhead «■ Of 

IF TM THEN %ITO SORT MERGE XTR*117 

BEGIN P (10, COM); %RETURN MERGE MATRIX XTR*117 

GO TO PCP0LYMERGE3IX GO TO ITO MERGE XTRM17 

END; XTR-U7 

SORTDONE' 

COMMENT JUST DID FINAL PASS* 
COMMENT RETURN EVERYTHING; 
PC[D0TnP3&0[18*18S153»6*ll*C0M,DEL*DEL)* 
IF NOT OPTOG THEN BEGIN 
PCMKS,2*0* CQUTFILCNOT 23 3*4*FCR) 
; IF NOT AC THEN P CO* OUTF IL I NOT 2 3 *8* CDC* STD ) ; 

END ELSE 
BEGIN COMMENT CALL OUTPUT PROCEDURE PASSING ENQ-OF-SORT FLAG; 
IF AC THEN 

BEGIN ENDQ «- \) IF ACH46J13 THEN 

P(MKS,8INGQ#0,PERF0RMGEN) % C0B0L68 
ELSE P(MKS*BINGQ*CPRTBASECP(DUP)3 3*L0D#IPFI0X»C0C3 
END ELSE PCMKS*1*MeM,0*0uTPR0); 

ST M T\ * 

PC 10,CQM>; % RETURN MERGE MATRIX XTRM17 

IF OUTCOUNT^INCOUNT THEN P ( INCOUNT* OUTCOUNT* 0* 
CDOTOP[NOT 2n*82*l7*C0M); 

pc10»c0m); x fall out of block com will return everything 
end disksort; 



00774500 
00774550 
00774600 
00774700 
00774800 
00774900 
00775000 
00775100 
00775120 
00775130 
00775140 
00775200 
00775300 
00775400 
00775500 
00775600 
00775700 
00775800 
00775900 
00776000 
00776100 
00776200 
00776250 
00776300 
00776400 
00776500 
00776550 
00776600 
00776700 
00776800 
00776900 



T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



097913 
0982*1 
0982*3 

0985*1 
0985*3 
0985*3 
0988'0 
0989*1 
0989*2 
0990*2 

0993*1 
0993*1 

0993*1 
0993«l 
09938 1 
0995*1 
0996*1 
0999*3 
1003*1 
1003*1 
100313 
1004*0 
1006*1 
1007*3 
1010*0 
1011*3 
1011*3 
1012*1 
1014*1 
1016*0 
1016*2 



SIZE* 1017 WORDS 



PROCEDURE POLYMERGEC 

START OF REL 
T1*T2,T3* 

endq* bingo* i pfidx#0utpr0,inpr0#0utf* inf* 
0ptqg*ipt0g»dk0,dki*tp1*tp2*tp3»tp4*tp5*nt* 
hivalu*equals*r,alfa*cqresize*disksize)* 
comment disk-sort 8y l.r. guck date 9/19/1965 * 

value optog, iptog* nt* h i valu* equals* r* alfa* 
coresize'DIsksize; 
real endq*blngo* ipfidx,0utpr0* inpr0*0utf* tl* t2» t3* ihf i 
boolean 0pt0g*ipt0g; 
real 0k0*dku 

name tp1*tp2*tp3*tp4*tp5; x scratch tapes 
real nt*hivalu*equals*r; 
boolean alfa; % true for alpha keys 
real coresize; % core storage available 
integer disksize; x disk storage available 

BEGIN 
LABEL MIC*MlD,MIE*START*TPD*TPF*TPF*RTNTR*TRA*SORTOQNE*RTA*TRXi 
REAL S*M*MS*STPP*D*OD*BF*TBO*I*X*Y*DNj 
ARRAY VC*3J NAME VN * V* 



00800000 

segment; DISK 

00800100 
00800200 
00800300 
00800400 
0©800500 
00800600 
00800700 
00800800 
00800900 
00801000 
00801100 
00801200 
00801300 
00801400 
00801500 
00801600 
00801700 
00801800 
00801900 



T 0000*0 
ADDRESS * 



00179 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 







REAL 



DEFINE 
DEFINE 



REAL VI 
ARRAY M 
NAME M 
NAME DO 
BOOLEAN 
BOOLEAN 
DEFINE 

COMMENT 
NAME I 
NAME OU 
NAME W 
ARRAY P 
REAL AC 
REAL 
NAME 
REAL 



IN 

ME 

BL 

PE 

8L 

ARRAY PR 

REAL OF 

ARRAY 8 

ITP.DONTD 

DEFINE 

COMMENT 

INTEGER 

INTEGER 

NAME 

NAME 

ARRAY 

ARRAY 

ARRAY 

REAL 

NAME 



*]J 

*3i 

sCORE 

od; 
%** 

SUBROUTINE WAIT> COMMEN 

ON 
$ SET OMIT = NOTCTIMESHARI 

CPCXC 



VXisFL 
VA1 
VA 
VA|, 

ow; 

HKC*3 J 

HNsMHK 
TOP =s 
MORED 
MFa J 
IOC ' 
P a 
PARAM 
NFIL = 
TFIL a 
AOUT * 

RFIBC* 

* 

COUNT, 
M a 
OCK x 
RFORMq 
KCTR = 
TBASE 
,OH,LO 
ASEC*3 
ONOTHI 
FCR a 
PARAM 
CTR 
COT 
CQI 
19', 

TSC 
TC£ 

TNt 
jMi 

CII 



AGCVC 

= FL 

a fl 

= FL 

% I 

% H 

* 

dko; 

ATA,F 
U 

®2000 

PQLIS 

ETERS 

INF; 

OUTF 
12} 
V 

% 1 

OUTCO 

2; 

5»AUW 

EN = 

16; 
a IOC 

,ONS, 

f 

NIEOP 
IF AC 
ETERS 

Li 
00; 



X + 13>#> VX=FlAGCV[X3)#, VLaFLAQ( V [ VLOW ] )#« 
AG(VtX+l ]&PcO,RDS)tCTF3)#> 
AGCVCX 31PtO#RDS)tCTF3)## 
AG(VCVLOW3&P(0#RDS)CCTF3)#; 

NDEX OF NEXT RECORD IN SEQUENCE 
IGH KEY FOR MERGE PHASE 



m>eof>tm,df>tr; 

oooooo#> 
h#; 

related to programmers files; 
% pointer to top i/o desc, 

% C0B0L68 OUTFILE WORK AREA 

% contains tape files fib 
rue for cobol input file 
unt; 

Ral2,ALRD*13,C0FCRal2,C0RW*U,ALFCR*l4, 
13# % C0B0L68 IN-OUT PROCEDURES 

* 1 ' 

orc>ocda,orl,QRI'SRi,srs,qbc,ifb,ifh; 
% pointer to control info in data 

EN, LISA* 

ELSE ALFCR#; 
MERGE TAPES; 

CONTROL TAPE 
OUTPUT TAPE 
I/O D OF CURRENT OUTPUT TAPE 



THEN CQFCR 

RELATED TO 

% CURRENT 

CURRENT 

LOC OF 



X 
% 
% 

% 

% 



BASE POINTER OF MERGE TAPES 
ARRAYS FOR CONTROLLING DISTRIBUTION 
PATTERNS ON MERGE TAPES 



size; % TAPES - 1 

% LOC OF I/O D FOR CURRENT 



INPUT TAPE 



********************************% 



S 

$ 



POP 
SET 



OMIT = NOTCTIME 

BEGIN IF NOT 
OMIT 

omit » ti^eshar 
pcded; end w 



T WAIT 

TOP OF 

NG) 

H>DUP»LOD)>, [19113 



FOR I/O 
STACK; 



COMPLETE USING ADRRESS 



THEN P(I0C#36,C0M»DEL); 



SUBROUTINE RELEASE 
BEGIN 
PRFI8UU * 
PCCOIODC03 «• 
RTAJ P(OOIQD); WA 
IF C*COIOO), 
BEGIN 

PCMKS,Q,0>CCO 
GO TO RT 

end; 



ING 

ait; 

. % *************** MM ***************** % 
TAPE; % CALLS MCP TO WRITE OUT BUFFERS 



T80; 
FLAG 

it; 

C27S1 



a; 



(PRFI8[163)*C0I0D#PRL*DEL>; 
3 THEN % REEL SWITCH 

IODCNQT 233*6*FCR); 



O®8O2O00 
00802010 

00802020 
00802030 
00802100 
00802200 
00802300 

00802400 
00802500 
00802600 
00802700 
00802800 
00802900 
00803000 
00803100 
00803120 
00803200 
00803300 
00803400 
00803500 
00803600 
0©80361G 
00803700 
00803800 
00803900 
00804000 
00804100 
00804200 
00804300 
00804400 
00804500 
00804600 
00804700 
00804800 
00804900 

01805000 
00805100 
00805200 

00805300 
00805400 
00805500 
00805550 
00805552 
00805553 
00805599 
00805700 
00805800 
00805900 
00806000 
00806100 
00806200 
00806300 
00806400 
00806500 
00806600 
00806700 
00806800 



0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0001*0 
0001*0 

0001*0 
0004*0 
000fl*0 
0004*0 
0006*0 
0006*0 
0006*0 
0006*0 
0007*1 
0009*2 
0011*0 
001210 
0012*2 
0016*1 
0016*3 



• 
• 
• 
• 
• 
• 



* Ik 



233*74,17, com); 



F N0TC*CQI00).C2I1] THEN P C I , CCOIODtNOT 2)1*7 
OIODCO] «■ 1 INX FLAG(PRFI8tl6) ♦• NFLAGC *COIOD ) ) 1 

n on c a «c T a or ! 

I BLOCKS OUTPUT TAPES 



• 

• 
• 
• 



RECORD COUNTER + 1 

1) > THEN X BLOCK COUNTER 



% ZERO CONTROL WORD IN 8UFFC23 



end releasetape; 
subroutine tapewrlte; 

BEGIN 
PRFIB «■ *CCOIODCNOT 23); 
PRPIBE9) «• PRFIBC93 ♦ 11 % 
IF (PRFIBtll] «■ PRFIBCin * 
COIODC03 + R INX *COIOO 
ELSE 

begin % time for release 
p(0,prfibc163 inx m£m*std51 
relfasetape; 

ENOl 

END TAPE^RITEI 

subroutine writestopper; 

begin % writes end of string or dummy strings 
prfib * *[coiqd[not 23); 

X * PRFlBC9HCTBO-PRFlBtll3)tl8$33:i53&f"DS w )C3533U53l 

p(x,prfib[163 inx mem,sto)i 
tnccoti <- tnccot3 ♦ u 
releasetape; 

PRFIB [9] «- ; 

end writestopper; 
subroutine openout; % opens programmers output tape 

BEGIN 

IF OPTOG THEN 

BEGIN P(MKS>[QUTFIL3'RM»1M * BLOCK); 

IF AC THEN 

BEGIN BINgO <- OUTPRO* ENDQ 4- 01 

IF AC. [46^13 THEN X C0B0L68 

BEGIN pcmks, bingo, o,performgen); 

COIOD *■ tWAOUTJj 
WAOUT * P(*[QUTFIL3,0,CDC)1 
END ELSE 
P(MKS*BlNGo,CPRTBASECP(DUP)3 3*LOD*lPFlDX,COC); 
END END ELSE 

BEGIN TR * FALSE! PRFIB * OuTFILCNQT 231 
PRFIBU33, [27*13 *0; 
IF AC THEN 
BEGIN 

P(MKS,C0UTFILCN0T 2 3 3 , 3,CQFCR ); 



% COUNT UP STRINGS ON OUTPUT TAPE 

X ZERO OUT STRING CTR 



IF AC,U6:i3 THEN 

BEGIN COIOD * 
WAOUT *• 



end; 

«- PRFlB[43,tBS4) 



% C0B0L68 
CWA0UT3; 

P(PRFIBC203.[FF3,DUP*DIB G#LOD,0* 
C0C,DEL*DI8 0,LOD)1 



TR 
END 
ELSE BEGIN P ( CQUTFIL 3 , 0, 1 1 , COM, DEL* DEL ) i 

PCMKSM*0*0»(-R)»C0UTFIL3'ALWR»DEL)1 END! 



END 
END OPENOUT 1 






SUBROUTINE 
BEGIN 



X**********************************% 



TAPEREAD1 % READS TAPES ON POLYPHASE MERGE 



00106850 

00806900 

00807000 

00807100 

00807200 

00807300 

00807400 

00807500 

OOS07600 

00807700 

00807800 

00807900 

00808000 

00808100 

00808200 

00808300 

00808400 

00808500 

00808600 

00808700 

00808800 

00808900 

00808910 

00809000 T 

00809100 T 

00809200 

00809300 

00809400 

00809500 

00809600 

00809700 

00809730 

00809740 

00109745 

00809750 

00809760 
00809800 
00809900 
00810000 

00810100 
00810200 
00810300 
00810400 
00810440 
00810450 
00810460 
00810470 
00810480 

00810600 
00810700 
00810800 
00810900 
00811000 
00811100 
00811200 
00811300 
00811400 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0016*3 
0020*2 
0023*2 
0023*3 
0024*0 
0024*0 
0025*3 
0027*3 
0030*1 
0031*0 
0032*1 
0032*3 
0034*1 
0035*0 
0035*0 
0035*1 
0036*0 
0036*0 
0037*3 
0041*0 
0042*2 

0044*2 
0046*0 
0047*1 
0049*0 
0049*0 
0049*0 
0049*0 
0049*1 
0051*2 
005l»3 
0054*1 
0055*0 
0056*2 
0057*1 

0058*3 
0058*3 
0061*0 
0061*0 
0064*0 
0066*2 
0066 * 3 
0067*1 
0069*0 
0069*3 
0071*0 
0073*1 
0074*3 

0074*3 
0076*3 
0076*3 
0078*3 
0081*0 
0081*0 
008U1 
0081*1 
0082*0 



I 

4 
4 







TRAJ 



• 



• 
• 



CIIOD «- TPCVLOW + 1 ]J PRFIB «- CIIODCNOT 23; 

PRFIBC9] *■ PRFIBC93 + H % RECORD COUNTER + 1 

IF (PRFIBtlH «" PRFIBtll] -1) > THEN % BLOCK COUNTER - 1 
VtVLOW] «- R INX VtVLOW] 

begin % time for release 
if (y «■ pcflagcprfibc163)^loo)) i then 
begin % control word i so end of string 

df «- true; 

if y.u3515] t prfibc93.c33i15] then 

p(0*c ciiodcnot 2 3 3, 85* 17, com, del 'del* del); 

END? 
PCCIIODC03 «■ FLAG(PRFI8tl63),ClIOD*PRL,DEL>; 

trx! p(ciiod); wait; 

if not c*cii0d).c2i13 then % error or eof or eqr 

BEGIN 
EOF * P<MKS,l,0,tCnODtNOT 233,6,FCR); 
IF NOT EOF THEN GO TO TRX; 

end; • 

if eof then go to rtntr; 

PRFIBtll] * IF P(Y* P(*ClIOD,LOD)) ■ THEN TBO 

ELSE Y.C18H5J; 
CIIODC03 «- 1 INX FLAG(PRFIBC16] «• NFLAG( *C I IOD ) ) ; 
IF OF THEN GO TO RTNTR* 
IF PRFIBC113 t THEN VtVLOW] «• VC VLQW]&( *C I IOD ) t 331 33 ! 15 3 

else go to tra; 
end; 
rtntr* if eof or df then begin 

vtvlow] *• nflag(mhk)&msc18$33*15j; 

if fm and not mf then % rel tape lst pass 

pcmks,4*0,ccil0dcn0t 23]*4,fcr); % for srt 

eof*df«-false; 

end; 



END TAPEREAO; 



&************ ********* ******#******; 

% READS PROGRAMMERS MERGE FILES 



subroutine inreao; 

R P C T H 

"CIIOD «- TPCVLOW + n; PRFIB «- ciiqdenqt 23; 
BEGIN 

IF AC THEN TCCVLOW3 <■ P CMkS,R, CI IOD,0, CORW ) 
ELSE 
BEGIN 

pcmks,o*o*ciiod*alrd); 
tcevl0w3 * pcmks,0,3*cii0d*alrd) < 0; 
end; 
if tccvlow] then vtvlow] * nflagcmhk )&msc 1 8 * 33 * 15 3 
else if (ac and 3) x 3 then % not c0b0l68 

VtVLOW] «■ £*P(DUP)) & C*CCII0D3)tCTC]; 

end; 
end inread; 

%***************************#*****% 
SUBROUTINE WRITEQUT; 

BEGIN % SELECTS FILE TO BE WRITTEN DURING MERGE 
IF NOT FM THEN TAPEWRITE 
ELSE 
BEGIN COMMENT CALL OUTPUT PROCEDURE OR WRITE INTRINSIC; 
OUT-COUNT * OUTCOUNT +1J 



00811500 
00811600 
00811700 
00811800 
00811900 
00812000 
00812100 
00812200 

00812300 
00812400 

00812500 

00812600 

00812700 

00812800 

00812900 

00813000 

00813100 

00813200 

00813300 

00813400 

00813500 

00813600 

00813700 

00813800 

00813900 

00814000 

00814100 

00814200 

00814300 

00814340 

00814350 

00814400 

00814500 

00814600 

00814700 

00814800 

00814900 

00815000 

00815100 

00815200 

00815300 

00815400 

00815500 

00815600 

00815700 

00815800 

00815900 

00815910 

00816000 

00816100 

00816200 

00816300 

00816400 

00816500 

00816600 

00816700 

00816800 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 

T 

T 
T 

T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0082«0 
0085»3 
0087*3 
0090*1 
009113 
0092*3 
0093»1 
0095*1 
0095*3 
0096*2 
0098*2 
0101*3 
0101*3 
0104*0 
0105*0 
0106*1 
0106*3 
0111*0 
0111*3 
0111*3 
0112*3 
0115*2 
0117*2 

0120*2 

0121*2 

0124*2 

0125*1 

0125*1 

0126*2 

0128*3 

0129*3 

0134*0 

0135*1 

0135*1 

0135*2 

0135*2 

0136*0 

0136*0 

0139*3 

0139*3 

0142*0 

0142*3 

0143*1 

0144*2 

0147*1 

0147*1 

0149*3 

0152*1 

0155*0 

0155*0 

0155*1 

0155*1 

0156*0 

0156*0 

0157*3 

0158*0 

0158*2 



m 






• 



• 



IF QPTOG THEN 
BEGIN 
IF AC THEN BEGIN ENDQ * 0; 

IF AC,U6{1] THEN PC MKS,BINGO*0,PERFaRMGEN ) 
ELSE P(MKS,BINGO»CPRTBASECP(OUP)3 3#IOD#IPFIDX*COC) 
END ELSE P(MKS,0#*COuTFlL3»O^OUTPRO); 
END 

else 
begin comment output file rather than output procedure; 
if ac then pcmks,0#1>1#0#r#coutfjl3#1#corn) 
else begin 

P(MKS#l*0#0#R,COUTFlL3»ALWR)i 

p(mks*1#0#0»(-r)»coutfil3#alhr#del); end; 
if tr then if p then p ( 1 , [qutfil t not 23 ] , 83* 17, com )} 

end; 

end; 
END writeout; 

SUBROUTINE FIR5TS E LECTJ 
BEGIN 

X *■ o; I*MS-U 
DO BEGIN 
IM + 1J 

VC 1 3 «■ VtX+CCIF ALFA THEN PC 0* MKS, 0* VX1* VX, EQUALS ) 
ELSE IF AC THEN PCO#MKS» VX 1> VX, EQUALS ) 
ELSE PCMKS,VA1,0,VA,Q, EQUALS)) AND TRUE)]; 
END UNTIL CX<-X + 2) » STPP; VlOW * 

END firstselect; 
subroutine lowselect; 

BEGIN 

X «• VLOW AND 1022; 
DO BEGIN 

I «■ MS + X.C38593; % I ] MS ♦ CX/2) 
VC I 3 * VCX + CCIF ALFA THEN PC 0, MKS, 0, VX1,VX, EQUALS > 
ELSE IF AC THEN PC 0,MkS, VX 1* VX, EQUALS ) 
ELSE PCMKS,VAl,0,VA,0, EQUALS)) AND TRUE)]; 
X <- I AND 1022; 



% initial selection of low record 



vcn,Ei8ii5j; 



END UNTIL I 

END lowselect; 



= stpp; vlow «• vtn.ciBiisi; 

* MERGES M STRINGS TO 1 STRING 



# 
• 



subroutine mergeit; 

BEGIN 

mic: firstselect; 

go to mie; 
mids lowselect; 
mie s if vlow < ms then 

begin; % MOVE low record to output file 

STREAMCP1*VL»P2*R»P3*(P(D-.UP))'.E36I6 3*P4**C-C0I003>; 

BEGIN Si<-P1;p3CDS«-32WDS;0S*32WDS);DS* P2 WDS END; 

writeout; if mf then inread else taperead; 
go to mid; 
end; 
for i *• q step 1 until ms-1 do % check for record m high key 

if cvlow «• v-ci],.c1b*is3) < ms then gq to miej 
end mergeit; 

ST Art I 

CIIOO «■ 0; P(CCClI0D].C33U53 + 2)#STSj; 

MS <- 2; TMl«-NT-i; WHILE MS<CTMl+MF) DO MS*MSx2; 



00816900 


T 


015913 


00817000 


T 


0160*0 


00817100 


T 


0160*2 


00817120 


T 


0162*1 


00817150 


T 


0164*1 


00817200 


T 


0166*3 


00817300 


T 


0168»3 


00817400 


T 


0168»3 


00817500 


T 


0168»3 


00817600 


T 


016911 


00817700 


T 


017210 


00817800 


T 


0172:3 


00817900 


T 


017412 


00818000 


T 


0176*3 


00818100 


T 


0180*0 


00818200 


T 


0180*0 


00818300 


T 


0180*0 


00818400 


T 


0180*1 


00818500 


T 


0181*0 


00818600 


T 


0181*0 


00818700 


T 


0183»0 


00818800 


T 


0183*0 


00818900 


T 


0184*1 


00819000 


T 


0188*2 


00819100 


T 


0192*2 


00819200 


T 


0199*3 


00819300 


T 


0203*3 


00819400 


T 


0204*0 


00819500 


T 


0204*0 


00819600 


T 


0204*0 


00819700 


T 


0205*1 


00819800 


T 


0205*1 


00819900 


T 


0207*0 


00820000 


T 


0211*1 


00820100 


T 


0215*1 


00820200 


T 


0222*2 


00820300 


T 


0223*3 


00820400 


T 


0226*3 


00820500 


T 


022710 


00820600 


T 


0227*0 


00820700 


T 


0227*0 


00820800 


T 


0227*0 


00820900 


T 


0228*0 


00821000 


T 


0228*2 


00821100 


T 


0230*0 


00821200 


T 


0230*3 


00821300 


T 


023111 


00821400 


T 


0234*0 


00821500 


T 


0236*1 


00821600 


T 


024l>0 


00821700 


T 


0241*2 


00821800 


T 


024j 12 


00821900 


T 


0245*3 


00822000 


T 


0249*0 


00822100 


T 


0249*1 


00822200 


T 


0262*2 


00822300 


T 


0265*0 



n 



* 



• 



• 



IF Mr THEN 

BEGIN % MERGE ONLY 

T^ «• ((NOT 7) INX [NT])j FM «. TRUE; 

p c mks. [ vn 3, c2xms)- 1.1*1.1. block); pcmks. cmhn } , r. \ , l, 1 .block )} 
pcmks. mhk); if not ac then pc 0. cdc. mhk. xch. rds* cfx. ) ; 

pchivalu); 
for vlow <■ step 1 until tmj do 
begin % open tapes 

CIIOO *■ TPCVLOW + lj; PRFIB * ClIODCNOT 23; 
PRFIBE 133 . C27 : 1 3 <- 1 ; % SET TO OPEN INPUT 
IF AC THEN PCMKS. CCIIQDCNOT 233.1.COFCR) 

ELSE TCtVLOW3«-P(MKS,0.3*CnOD.ALRD)<0; 
IF PRFIBC53.C39J1J THEN T C CVtOW3 «- 1 ELSE XQPTIQNAL 
BEGIN 

pcciiqd); wait; if ac then inreao; 
end; 



end; 
for 

8EGIM 
IF 



end; 

openout; 

STPP «- 2 

merge it; 

FOR I 
BEGIN 



I ♦ STEP 1 UNTIL MS-1 DO 

I > TM1 OR TCCI3 THEN VCH «• NFLAGCMHK )$MS C 18 J 33 ! 153 
ELSE VCI3<-NFLAG(P(TP[I + 13)&(IFCAC AND 3)*3 THEN 

PC2.N0T.XCH.INX.L,0D.20*C0C.0.XCH*FCX*DIB O.LOD*!) 

ELSE PCL0D*I)HCTF3); 



IFCAC 
x MS « 



AND 
2; 



3)/3 THEN COIOD * OUTFIU 



«•! STEP 1 UNTIL TM1 + 1 

CIIOD <-TP [13 ; 

P (MKS.2.0.CCII00CN0T 2 



end; % 
go to soktdone; 
end; 

for i * cot step 1 until 
if tnci3 < tcc i 3 then 

BEGIN 

IF COT i I THEN 
BEGIN 
PRFIB 



DO %CIQSE LOCK ALL 
33#4»FCR); 



TAPES 
% PG 

* PG 

* PG 



TM1 DO % WRITE OUT DUMMY STRINGS 
% PERFECT DISTRIBUTION 



COIODENOT 23; COIQOC03 
PCCCNQT 2) INX TPCI33.CCNOT 2) 
20.C0M.DEL.DEDj 
TPCI3; C0I0DC03 «• 1 INX *C0I0D; 



* FLAGCPRFIBC163); 
INX TPCC0T3). 



1; 



DO 
TP[I3 ; PRFIB * COIODENOT 23; 



% PERFECT DISTRIBUTION PATTERN 
COIODE 

PRFIBC9] «* 0; writestopper; 



COIOD 

COT «■ 

end; 

WHILE TNCI3 < TCCI3 
BEGIN COIOD * 

PRFIgClU ♦ TBO; 

end; 
end; 

FOR I * 
BEGIN % 

CIIOD 
PCMKS. 

end; 

PCMKS.[VN3.(2xMS)-i.i,i.i,BLOCK); STPP 

PCMKS. [MHN3*R.1M.1*BL0CK); % HI-KEY 

PCMKS. MHK); IF NOT AC THEN P C 0' CDC* MHK. XCH.ROS* CFX. ) ; 



1 STEP 1 UNTIL TM1 DO 

! SET UP TO DO POLYPHASE MERGE 
«■ TPU3 ; 

2 *0,C.CIIODCNOT 233.6.FCR).* 



% 



REWIND OR 
* 2xMS-2; 



RELEASE 

mhn*o; 



00822400 
00822500 

00822600 
00822700 
00822800 

00822820 
00822900 
00823000 
00823100 
00823200 
00823300 
00823400 
00823500 

00823600 

00823700 

00823800 

00823900 

00824000 

00824100 

00824200 

00824300 

00824310 

00824320 

00824400 

00824500 

00824550 

00824600 

00824610 

00824630 

00824660 

00824670 

00824700 

00824800 

00824900 

00825000 

00825100 

00825200 

00825300 

00825400 

00825500 

00825600 

00825700 

00825800 

00825900 

00826000 

00826100 

00826200 

00826300 

00826400 

00826500 

00826600 

00826700 

00826800 

00826900 

00827000 

00827100 

00827200 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0270*2 
0270*3 

0271H 

027312 

0278»0 

0282*0 

0282*1 

0283*0 

0283*0 

0286*3 

0289* 1 

029H2 

0295*0 

0297*3 
0298*1 
0302*0 
0302*0 
0304*1 
0308*2 
0308*2 
0312*0 
0316*2 
0320*0 
0322*1 

0322J3 
0326*2 
0328*1 
0329*0 
0333»l 
0334*3 
0338*2 
0339*0 
0339*2 

0339*2 
0341*0 
0342*1 
0342*3 
0343*2 
0344*0 
0347*0 
035012 
035U2 

03S4*2 
0355*1 
0355*1 
0357*0 
036011 

0364*0 
036412 
0366*3 
0368*0 
0368*0 
0369*2 
0373*1 
0375*2 
038013 
0382*2 



• 



* * 



# 



TPO; 



• 



TPE 



• 



PCHIVALU)^ 
FOR I * 1 STEP 1 UNTIL TMl DO 
BEGIN % OPEN INPUT TAPES 
CIICID «- TPtH i PRFI8 «- CIIODCNOT 23; 
PRFI8Cl3],C27in <- l; P(CIIOD#OMl»COM»DEL#OEL)J 

pcciiod); wait; prfibciu *■ t&o; pRFism *■ o; 

ciiQDcoi <■ i inx *cnoo; 

end; 

fm <- true; 

for i * 1 step 1 until tml do if tnci3 > 1 then fm * false; 

if fm then 

begin openout; ifcac and 3>*3 then coiod 

ELSE % OPEN SCRATCH OUTPUT TAPE 
BEGIN COIOD ♦ TPCNT3; PRFIB * *CCOIODCNOT 
PRFIBC133.C27H] «■ Oi % SET TO OUTPUT 

P(CQIOO»0* 11* COM* DELUDED; 

PRFIBCH] «• TBO; PRFIBC9] *• o; COT * NT; 



OUTFIL END 
2311 



wait; coiodco] * i inx flag(PRfibc163 ); 



up vector row o; 

UNTIL MS - 1 DO 



END; 



IF 
IF 

TPFJ IF 



P(COIOD); 

END? 

COMMENT SET 

FOR I «- STEP 1 
BEGIN 

IF I > TMl THEN BEGIN EOF *■ TRUE; GO TO TPF 
CIIOD * TPCI + U ; PRFIB *• CHOOCNOT 23; 
IF (EOF «• <*CIIOD>. [27*13 ) THEN GO TO TPF; 
( X «■ (*<FLAG(PRFIBC161)))> XO THEN 
NOT C EOF <-X.C33S.153 s ) THEN PRFIBC113 *X, 

ELSE ELSE PRFIBC113 * TBO ; PRFIB[93 <-0; 
TNCI+13 = OR EOF 
THEN BEGIN 

VCI3 ♦NFLAG(MHK)«MSC18»33li5]j 
IF FM AND I LSS TMl THEN P(MKS,4,0, [ C I IODCNOT 
END 

ELSE VCI3 «• NFLAGCP<*TPCI + n)«tC18i33»153)I 

eof «• false; 
end; 

mergeit; 

if fm then go to sortdone else wri testopper; 
comment have merged a string off each tape; 
comment check if rewlnd needed; 
for i <- 1 step 1 until tml do tnci3 «• tnci3 - i; 
for i * 1 step 1 until tml do if tnci3 < then 
begin % rewind is needed 

prfib <- coiodcnot 23; 

pcmks* 2 *0»ccolodcnot 233,6,fcr); % rewind or release 

ciiod«-tp[ij) 

p<mks»4,q>[cii0d[n0t 233,4,fcr); % close purge 

tnci] «■ tn[nt3; tn[nt3«- 0; 

prfibc 1 33 • t27 : 1 3 <- 1 ; % set former output to input 



*TR*142 
[181153 %TR*1«2 
XTR*142 



% PG 
% PG 
233#«#FCR); 

% PG 



P(CnIOD»OMl*COM,OEL»OEL); 
pccoioo); WAIT; COIODC03 ♦ 

pc(tp[nt3)>; tpcnt3 ♦ tpci3; 
go to tpd; 
end; 

go to tpe; 
sortdone* 



* open for input 

1 inx flag(prfibc163)j 

Tptn «■ p(xch); 



%TR*142 



00827220 

00827300 

00827400 

00827500 

00827600 

00827700 

00827800 

00827900 

00828000 

00828100 

00828200 

00828250 

00828300 

00828400 

00828500 

00828600 

00828700 

00828800 

00828900 

00829000 

00829100 

00829200 

00829300 

00829400 

00829500 

00829600 

00829610 

00829620 

00829700 

00829800 

09829825 

00829850 

00829875 

00829900 

00830000 

00830100 

00830200 

00830300 

00830400 

00830500 

00830600 

00830700 

00830800 

00830900 

00831000 

00831100 

00831200 

00831300 

00831400 

00831500 

00831600 

00831700 

00831800 

00831900 

00832000 

00832100 

00832200 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0386»2 
0386*3 
038810 
0388*0 
0391! l 
0395*1 
0399*2 
040l»0 
040 3 M 
0404*0 

0409*2 
0409*3 
0413*2 
0413*2 
0417*1 
0419*3 
042111 

0424*2 
0427* 3 
0427*3 
0427*3 
0432*0 
0432*0 
0434*2 
0438*1 
0440*2 
0442*2 
0446*0 
0450*3 
0452*1 
0453*1 

0455*2 
0461*0 
046l*0 
0465*0 
0465*3 
0466*1 
0467*0 
0469*0 
0469*0 
0469*0 
0474*1 
0476*0 
0476*2 
0478*1 
0482*0 
0483*2 
0487*1 
0490*0 
0492*2 
0492*2 
0494*0 
0496*3 
0501*2 
0502*0 

0504*1 
0504*3 



# 



# 
• 



COMMENT JUST DID FINAL PASS) 
COMMENT RETURN EVERYTHING; 
IF NOT MF TH E N 

PUDOTOP3&OC18I18I15J*6»11»COM»DEL»DEL)J 
IF NOT OPTOG THEN BEGIN 
P(MKS,2,0,CQUTPILtN0T 233,4,FCR) 
IF NOT AC THEN P( COUTF ILC NOT 23 , 8, CDC, STD ) ; 

END ELSE 
BEGIN COMMENT CALL OUTPUT PROCEDURE PASSING END-OF-SQRT FLAG! 
IF AC THEN 

BEGIN ENDQ *• \l IF AC, [46:13 THEN 

PCMKS, BINGO, 0#PFRFQRMGEN) X C08OL68 
ELSE P(MKS,BING0*CPRTBASE[PCDUP3 3 3#L0D^IPFIDX*C0C) 
END ELSE P(MKS,l,MEM,0,OuTPRO); 
ENDi 

IF NOT MF THEN 
IF OUTCOUNT^INCOUNT THEN P( INCOUNT* OUTCQUNT* 0, 

CDOTOPtNOT 233, 82, 17, COM); 
PClCCQM); % FALL OUT OF BLOCK COM WILL RETURN 
END POLYMERGE? 



EVERYTHING 



00832300 
00832400 
00833000 
00833100 
00833200 
00833300 
00833400 
00833500 
00833600 
00833700 
00833800 
00833850 
00833900 
00834000 
00834100 
00834200 
00834300 
00834400 
00834500 
00834600 



T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0504*3 
0504»3 
050413 
0505*1 
050713 
0508*3 
0512*1 
0515*3 
0515*3 
0516*1 
0516*2 
0518*3 
0520*1 
0522*2 
0524*1 
0524*1 

0524*3 
0527*1 
0529*0 
0529*2 



SIZE* 0530 WORDS 



• 



REAL PROCEDURE DUMP INT C SN, CV*BV, T IPE, TENS* ALFA* CHAR,FIEL*F0RMT > ; % 

START OF REL 
VALUE SN,CV,8V, T IPE* TENS, ALFA, CHAR,FQRMT;% 
REAL SN,CV,BV, TIPE*TENS, ALFA, CHAR, FORMTJ % 

NAME FIELJ* 
BEGIN* 

REAL E«+l>% 

VALUEE-+2,% 
DHls+3,% 

DHga+4,% 
LNgTH"+8*X 
CSlZEs+6,% 
8CTR=+7« 

* TEMPs+8,% 
NL * + 9% 

* J *+lO,% 
TROWs+11,% 
C0UNTa+12#% 
TARRYs+13,% 

N=8V,« 

SlNNs9;% 
LABEL* 
PRINTS 
PR3,% 
8RTN,% 
TA,% 
TCP,% 
TCI 
IRTN*% 
P2»% 
Pi, I 
T8,% 



00900000 


T 


0000*0 


segment; DISK 


ADDRESS * 


00900100 


T 


0000*0 


00900200 


T 


0000*0 


00900300 


T 


0000*0 


00900400 


T 


0000*0 


00900500 


T 


0000*0 


00900600 


T 


0000*0 


00900700 


T 


0000*0 


00900800 


T 


0000*0 


00900900 


T 


0000*0 


00901000 


T 


0000*0 


00901100 


T 


0000*0 


00901200 


T 


0000*0 


00901300 


T 


0000*0 


00901400 


T 


0000*0 


00901500 


T 


0000*0 


00901600 


T 


0000*0 


00901700 


T 


0000*0 


00901800 


T 


0000*0 


0§901900 


T 


0000*0 


00902000 


T 


0000*0 


00902100 


T 


0000*0 


00902200 


T 


0000*0 


00902300 


T 


0000*0 


00902400 


T 


0000*0 


00902500 


T 


0000*0 


00902600 


T 


0000*0 


0i902700 


T 


0000*0 


00902800 


T 


0000*0 


0©902900 


T 


0000*0 


00903000 


T 


0000*0 



00197 



• 

m 

• 
i 



• 



• 






• 



P3E»% 

TF,% 

1P2»% 

TP3*% 

TP22»% 

TP1#* 

TP8»* 

195,% 

TP11*% 

TD2#* 

TD3>% 

TP10»% 

TP9** 

TP6,S 

TP7,X 

TP71»% 

P3>% 

P3A#I 

P3L»% 

P3I,« 

EA»* 

£B*% 

EC** 

ED»* 

PS,* 

ZE*% 

£FAA#* 

EFA,% 

ERTN,% 

EFB#X 

efc;% 

SWITCH OCSWlTCH«-TA#TB,TC»TCP»fo;X 
SWITCH TIPESW«-P3L»P3E»P3A,P3IJX 
REAL RITEINT=12;% 
REAL SELECT = Ui% 
NAM E ¥=2i% 
DEFINE I»ALFA#JX 

SUBROUTINE RITE/* 
BEGINS 

P(MKS*1#0#0^LNGTH*FIEL*RITEINT* 

MK.S,l,0,0/(-l),FlEL/RlTElNT,DEL); 
ENOJX 
SUBROUTINE FINOE }% 

BEGIN IF P(VALUEExP1141O00oOOO0O0OO»0UP)X0 THEN* 
BEGIN* 

SINN«-PCDUP*0><); PCSSP#.VALUEE#SNO);« 
IF PCO>XCH,DlA 3>DIB 42,TRB 6>VALUEE*DlA 2% 
* DIB 1,TRB 1*12^, §1157163034761674, x,% 

pu54000000000000#+*.e#isn#oup)<0 'then go to efbj* 
pctens)jx 

efaa:if p < valuee then go to ertnjgo to efcu 
end;* 

pcdel>;% 

e*sinn«-o;go to ertnj* 
efbs p(chs#tens#1#xch#/); go to efaaj 



00903100 
00903200 

00903300 
00903400 
00903500 
00903600 
00903700 
00903800 
00903900 
00904000 
00904100 
00904200 
00904300 
00904400 
00904500 
00904600 
00904700 
00904800 
00904900 
00905000 
00905100 
00905200 
00905300 
00905400 
00905500 
00905600 
00905700 
00905800 
00905900 
00906000 
00906100 
00906200 

00906300 
00906400 
00906500 
00906600 
00906700 
00906800 
00906900 
00907000 
00907100 
00907200 
00907300 

00907400 
00907500 
00907600 
00907700 
00907800 
00907900 
00908000 
00908100 
00908200 
00908300 
00908400 
00908500 
00908600 
00908700 



T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0001*0 
0001*0 
0002*3 
0005*0 
0005*1 
0006*0 

0007*2 
0008*0 
0010*0 
0011*3 
0013*1 
0015*2 
0015*3 
0021*0 
002i*0 
002X x i 
0023*0 



i 

i 







• 



EFC* E*E-i;X 
ERTIU* 

end;x 

SUBROUTINE QUTi;% 

BEGIN FINDER 

PCVALUEE#,DH1^ISD);% 

STREAMcP8*dlP7*SlNN#P6*-[VALUEE3*P5*SlNN>P4»0#P.3*X 
E+l + SlNN*P2*0,Pl<-BCTR);X 

BEGINX 

P2(DS<-LIT" ")5X 

Pl*DUSI*p6JDS*P4 DECJ S I *P6 i S I »S 1 + 8; X 

DS*P3 DEC! P8*-Di;SI*Pl>DI*Pi*X 

p7(if scx«0« then jump real to iau 
ds*lit " »;si*si+i);x 

lASSifLOC P4jSl*Sl-iMF Sc»"l" THENX 
BEGIN* 

01*01-1 JX 

ds«.lit"- w ;x 

end;x 
end;bctr*p;x 
eno;x 
subroutine blnk;% 

BEGINiX 

STREAM(P3*CSl2E*P2*CSIZE DIV 64* P1*C BCTR**FIEL INX 0) 

);% 

BEGINX 

P2(32CD$*2 LIT" M ))U 

P3(DS*LIT" ");X 
ENDJX 

enq;x 

if f0rmts5 then dumpint*flel elsex 

BEGIN P(0#0#0 );% 

IF MCMCpiEL INX NOT 2] INX 5], [43*13 THENX 

P (MKS,0,0*FIEL,1> SELECT )J% 
IF PCMKS*1*0*0*C-1)#FIEL*RITEINT*DUP)>16 THEN P(0EL>16> ; 
IF PCDUP) <U THEN P(xlT)JX 
P(DUP*8*x,0*0 );blnkix 
; go to qcswitchcformt3;x 
stream(bctr*a*alfa ); begin di«-bctr;x 

si*loc a;si*si + u ds*7 chr end;% 
rite; pcx it );x 
if (temp*temp+1)sn then? 
if p ( temp" 1* not* [cv3>inx*l0d)*pctemp+n-i>n0t, ccv3,x 

inx^lod) then p(xit) else go to tcp;x 
tc! stream(8ctrm«-alfa ); begin oi*bctr!x 

si*loc a;si*si+i; ds*6 chr;ds*x 
i lit h c«; bctr*di;x 

end; bctr*p;x 

valuee*pcn-1#n0t^[cv]^inx*l0d)ix 

QUTI'X 
IRTN* l*-Q}% 



brtn 
ta* 



TCP* 



p2* if (i*i+1)<n thenx 

begin;streamcb«-o s bctr);% 

begin os* i lit%";b*di 
valuee*pcn-i-i*not*ccv]#inx#lod);x 
outi;go to P2; end;x 

PI : VALUEE*CV;% 



end;bctr*p;% 



00908800 
00908900 

00909000 
00909100 
00909200 
00909300 
00909400 
00909500 
00909600 
00909700 
00909800 
00909900 
00910000 
00910100 
00910200 
00910300 
00910400 
00910500 

00910600 
00910700 

00910800 
00910900 

00911000 
0O91H00 
00911200 
00911300 
00911400 
00911500 
009U600 
00911700 
009U800 
00911900 
00912000 
06912100 
00912200 
00912300 
00912400 
00912500 
00912600 
00912700 
00912800 
00912900 
00913000 
00913100 
00913200 
00913300 
00913400 
00913500 
00913600 
OB91370Q 
009J3800 

00913900 
00914000 
00914100 
00914200 
00914300 
00914400 



T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 

T 



0024 * 3 
0026*0 

0026*0 
0026*1 
0027*0 
0028*0 
0028*3 
0030*2 
0032*2 

0032*2 
0033*3 

0035*1 
0036*2 
0038*0 
0039»0 
0040*0 
0040*0 
0040*1 

0040*3 
0040*3 

0041*2 
004i *3 

0042*0 
0042*0 
0044*0 
0045*0 
0045*0 
0046*3 
0048*0 
0048*1 
0048*2 
0051*1 
0052*2 
0056*0 
0058*0 
0061*3 
0063*1 
0066*0 

0069*2 
0071*0 

0072*0 
0073*1 
0075*0 
0079*0 
0080*2 
0082?0 
0082*3 
0083*2 
0084*1 

0086*2 
0088*0 

0088*3 

0090*2 
0092*1 

0093*3 

0096*2 

0098*2 



• 



end; bctr«-pu 






streamcb«-oj bctr);% 

BEGIN DS<-2 LIT"]*"JB«-DI 
60 TO P3>% 
T85 V*UUEE*BVI« 

STREAMCBCTRJAIFA )) BEGIN DI«-BCTr;% 

si*loc alfa;si«-si + i; ds*6 chr;ds*-i iu«*«n 

BCTR<-0I* 
END) BCTR*P; GO TO P3;% 

td: streamcbctrjalfa ); BEGIN di*bctr;% 

si*loc alfa;susi + i; ds«-6 chr;ds*i lit"*";% 

bctr«-oi* 
end; bctr*p;% 
rite; 8lnkjx 

TF! P((LNGTHx8) OIVCIF TlPE-0 THEN 6 ELSE IF TlPE'l* 

THEN 19 ELSE IF TIPE* 2 THEN 9% 
ELSE 14),0,0,0,0,0,DEL*DEL);* 
P ( [TARRY H C2xN+ 1)1 8 1-381 10] )il*0;% 

TP2! P(o);% 

tp3: if (im + 1xn then go to tp2;% 
i«-o;pco,.cv»lQd>;go jo tpux 

TP22JP(0# f TEMP,L0D*LGD);% 
TP1IP(,TEMP#SND#DIA 8, DIB 38,TRB 10JMF (I*IM)<N THEN* 

GO TO TP22;% 
TP8: I*0;P( *C\JtlOO)}% 
TP5t IF(I*I+1)<N TH£N% 
BEGIN* 

pci, tarry, cdclod);go to tp5% 
end;* 
trow<-p; j*o;% 

tph*p(j);valuee*trow;go to P3;% 
tdl! if(j*j+1)<p(n'dup,+, tarry) then go to jp71x 

rite;blnk;% 
td2: rite;blnk;% 

TQ3: P(0,. COUNT, SND);gO TO TP6;% 

tp10* if p(n-i, tarry, 2xn-i, tarry, 1,",») 

pcn-i,[tarry],dup,coc»i,+'XCh,«-);go 
tp9* p(0,n"i*[tarry],«-,i); 

TP65 IF(I«-P(1, + )}bN THEN PCXIT) ELSE GO TO TP10;% 

tp7* 1f(c0unt*-c0unt + 1)xnl then go to tpufx 

rite;blnk;% 
tp7i:cqunt*o;go to tph;x 
p3* go to tipeswctipel;* 
p3a: stream(bctrsvaluee); 



THEN GO TO TP9;% 

TO tps;% 



• 
• 



LIT" ";ds*7* 



begin di*bctr;% 
suloc valuee;si*si + i;ds«-2 
chr;bctR*di;% 
end;bctr«-p;go to ps;% 
p3l * stream(v«-valuee and i?bctr); 
begin 0s«-6 lit " false"; 

VCDl«-Dl-5; DS«-5 LIT "TRUE M >; 

end; bctr*p;go to ps;% 

P3 T s IF VALUEE % 97777777777777 THEN% 

begin pc valuee,, valuee* i sn,dup»0,<,. si nn,«",» 
ssp, ,dh2,snd»p 104575 3604000000,0 1 v,x 
,ohi,o;% 

STREAM(P8«-0lp7*U,p6«.tDHl3»P5*SINN#P«4-«#P3*8*P2*2#X 

P1«-BCTR);% 



00914500 
00914600 
00914700 
00914800 
00914900 
00915000 
00915100 
00915200 
00915300 
00915400 

00915500 
00915600 
00915700 
00915800 
00915900 
00916000 
00916100 
00916200 
00916300 

00916400 
00916500 
00916600 
00916700 
00916800 
00916900 
00917000 
00917100 
00917200 
00917300 
00917400 
00917500 
00917600 
00917700 
00917800 
00917900 
00918000 
00918100 
00918200 
00918300 
00918400 
00918500 
00918600 
00918700 
00918800 
00918900 
00919000 
00919100 
00919200 
00919300 
00919400 
00919500 
00919600 
00919700 
00919800 
00919900 
00920000 
00920100 



T 
T 

T 

T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0099*1 

0100*2 
0102*0 

0102*2 
0103*1 
0104*3 
0106*0 
0106*1 
0107*2 
0109*0 

0110*1 
0110*2 
0111*1 
0113*0 
0116*1 
0119*1 
0122*0 
0125*0 
0125*1 
0127*2 
0129*2 
0130*2 
0133*2 
0134*0 
0135*1 
0137*0 
0137*2 
0139*0 
0139*0 
0140*1 
0141*3 
0144*3 
0147*0 
0149*0 
0150*1 
0154*1 
0157*1 
0159*0 
0161*1 

0163*2 
0166*0 
0167*1 

0170*1 
0l7i*3 

0172*3 
0173*1 
0174*2 
0176*1 
0177*1 
0179*1 
0179*2 
0180*3 
0181*2 
0184*0 
0185*1 
0185*3 
0188*0 



• 
• 



P3E: 



EC? 

EPS 



• 



• 



BEGIN* 

P2CDS«-LIT" ">;% 
Pl+Dltt 

si*-P6;% 

ds*p4 dec; $i*P6;si«-si + 8;ds*p3 dec;* 

P8«-0i;Sl*plJDl*PU% 

P7CIF SC/«0" THEN JUMP REAL TO IA;% 

ds«-ut " ♦•; si*si + n;% 

IASSI«-10C PKj Sl«.SI*l J IF SC«"l w THEN* 
BEGIN* 

di«-di-i;ds*lit "-";% 
end;* 
end;bctr*p; go to ps;* 
eno;% 

FINDE; DH2*0;* 
EB* IF PCVALUEE»E»11,->Dh2,+,DUP)<0 THEN* 
BEGIN PCCHS, TENS, MUD; Go TO ED ENDU 

pctens*/); 

IF P(DUp) < 97777777777777 THEN* 
BEGIN* 

P(.DHUISN);* 

IF P(DUP) > P(12'DH2,TENS) THEN* 
BEGIN* 

PCDELJJ* 

PCn-0H2fTENS, f 0Hl#lSN); 
E * E + Xi% 

end;* 
pcp 1045753604000000, idv, ,valuee#«->; 

STREAMCP10«-0{P9«-ABS(E)*P8*(E<0),P7*SINN#P6*DH2** 
P5*-[VALUEE]>P4<-4«DH2*P3«-8»P2*2,,Pl*8CTR>;* 
BEGIN* 

P2CDS«-UT» M );P1*DHSI*L0C P6;5l«-Sl-U* 

if sc-"i"% 
then begin* 

di«.di~ud5<-ut , '- w * 
end;* 
di«-di + i;si«-p5;ds*p4 dec;si*p5;si*si+8;x 
D5*P3 dec;* 
P6CDS<-LIT'»0")U 
DS*LIT"e M ;* 
si*ioc p7jsi*si-i;x 

IF SCs'T' THEN DS«.UT M *" ELSE DS*UT W + M ;* 

si*lqc p9jds*2 dec; pio*onsi«-Pusi*si*ij 
di«-pi;ds«-chr;ds*ut", m ;* 
end;bctr«-p;* 
p5« ip formtsa then go to tdu* 

rite; pcxit); end;* 

pcded;dh2*dh2+ugo to eb;* 
end;* 



end dumpint;* 



00920200 
00920300 
00920400 

00920500 
00920600 

00920700 

0§920800 

00920900 

08921000 

00921100 

00921200 

00921300 

00921400 

00921500 

00921600 

00921700 

00921800 

00921900 

00922000 

00922100 

00922200 

00922300 

00922400 

00922500 

00922600 

00922700 

00922800 

00922900 

00923000 

00923100 

00923200 

00923300 

00923400 

00923500 

00923600 

00923700 

0S923800 

00923900 

00924000 

00924100 

00924200 

00924300 

00924400 

00924500 

0®924600 

00924700 

00924800 

00924900 

00925000 

00925100 



T 
T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SIZE* 



0188*2 
0188*2 
0189*3 

0190*0 
0190*1 

019H3 
0192*2 

0194*0 
0195*0 
0196JQ 
0196*0 
0196*3 
0196*3 
0200*0 
0200*0 
020i*3 
0204*0 
0205*3 
0206*1 
0207*0 
0207*2 

0208*0 
0209*2 
0210*0 
0210*1 
0211*3 
0213*0 
0213*0 
0214*0 
0216*2 
0218*2 
0218*2 
0220*2 
0220*3 
022i JO 
0221*3 
0221*3 
0223*1 
0223*3 
0225*0 
0225*2 
0226*0 
0227*3 
0229*0 
0230*0 
0230*3 
0232*0 
0233*1 
0238*0 
0238*0 
0239 



WORDS 



PROCEDURE XTOTHEIINT(BASE#EXPON*M,LOG#EXP);X 



START OF REL 



01000000 T 0000*0 

segment; disk address * 00205 



• 



• 






VALUE BASE*£XPQN*M>LQG>EXP;% 
REAL BASE*EXPON*M*LOG*EXP;% 

BEGIN LABEL ROWS, MORE., EX IT; % 
REAL CTR=+l,F2=+2;X 
IF EXPON * THEN* 

BEGIN BASE * i; P(XIT) END;* 
IF BASE * THEN PCXIT)J* 
IF EXPON,C3:35] * THEN* 

BEGIN BASE «■ P C MKS, BASE* LOG* MKS* CTR*EXPON* x, EXP ) *% 
PCXIT);% 

end;* 
p(1*exp0n*base»dia 38* olb 39*exp0n);* 
rows:: if p(c*xch,fce 9) then* 

begin pcdel);* 
more:: if cctr ♦ ctr-1) * then go to exit;* 

go to more;* 

: x% 

end;* 

P(DEU)/% 

IF EXPON THEN* 

BEGIN CTR * CTR + 1'* 
P(DUP);* 

end;* 
p(dup*mul>0> expon* trb 9* , expon* snd ) j% 

GO to rows;* 
exit! if f2 < then pc1*xch*/);* 
base «• p;* 
eno;% 



OIOOIOOO 
01002000 
01003000 
01004000 
01005000 
01006000 
01007000 
01008000 
01009000 
01010000 

oionooo 

01012000 
01013000 
01014000 
01015000 
01016000 
01017000 
01018000 
01019000 
01020000 
01021000 
01022000 
01023000 
01024000 
01025000 
01026000 
01027000 
01028000 
01029000 



T 
T 

T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
OOOO'O 
0000*0 
0000*3 
0002*1 
0003*3 
0005*0 
0008*0 
0008*1 
0008*1 
0009*3 
0010*3 
0011*2 
00R*1 
001412 
0015*0 
0015*0 
0015*0 
0015*1 
0015*2 
0017*1 
0017*2 
0017*2 
0019*1 
0019*3 
0021*3 
0022*1 



size* 0023 words 



procedure statusintct#c>; value t*c; real t; integer c; 

BEGIN PCT*C#2R*C0M,DEl*RTN) ENd; 



01100000 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS s 00206 

01101000 T 0000*0 

SIZE» 0002 WORDS 



REAL PROCEDURE ABSINTCX); VALUE x; REAL X;* 
BEGIN PCABS(X)*RTN) END** 



START OF REL 



01200000 T 0000*0 
SEGMENT; DISK ADDRESS * 00207 
01201000 T 0000*0 

SIZE* 0002 WORDS 



REAL PROCEDURE SIGNlNT(X); VALUE X; REAL Xi% 
BEGIN P(SIGN(X)*RTN) END;* 



01300000 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00208 

01301000 T 0000*0 

SIZE* 0003 WORDS 



o 



INTFGER PROCEDURF ENTIERINT(X)! VALUE X* REAL Xj* 
BEGIN ENTIERINT «- X-.5 END** 



• 



REAL PROCEDURE TlMElNT (X)* VALUE X* REAL XIX 
BEGIN PCX*1* CUM*RJN) ENO** 



01400000 T GQOO'O 
START OF REL SEGMENT) OISK ADDRESS * 00209 

01401000 T 0000*0 

SIZE* 0003 WORDS 



01500000 T 0000*0 
START OF REL SEGMENT) DISK AODRESS * 00210 

01501000 T 0000*0 

SIZE* 0002 WORDS 



PROCEDURE DELAYINTCARRY* MASK* TIME);% 



VALUE ARRY, MASK* TIM£)% 

ARRAY ARRYf*]) REAL MASK) INTEGER TIME** 

BEGIN POLISHCARRY, MASK* TIME* 31* COM, DEL* DEL* RTN) END)!* 



%WF 01600000 T 0000*0 

START OF REL SEGMENT! DISK ADDRESS ■ 00211 

01601000 T 000080 



%wf 

SKWF 
XWF 



01602000 T 
01603000 T 



0000*0 
0000*0 



size* 0003 words 






PROCEDURE SQRTINT(X); VALUE X*' REAL X) % 

BEGIN REAL Y=+l*Z*+2** 
LABEL P5*0NE*% 
DEFINE INNER s XCH* MUL* DUP* Y* XCH*/##% 

ITER = P( + *P5* INNER)*)* 
IF X<0 THEN PCl,26*C0M)j % ARGUMENT CHECK 
IF P(ABS(X),DUP) / THEN* 

BEGIN P<ONE*+*DUP*0*DEL*% 

DIA 7* DIB 45* VFI 3 7, Y*% 
OIA 2* TRB 1*,0NE**#L0D*% 
Y*DUP*DIB 3*TRB 6* XCH* I NNER ) ) % 

ITERIITERHTERU 
P(Z*»*P5*x*+>*% 
END }% 
P(RTN))% 
P5*<* ■" *115*000000000000)* 
ONE*** ^1770000000000001*% 

01235560000000000,% 

§1233250000000000** 
^1222000000000000,* 
01221150000000000*% 
§0l55560OO0O000O0*X 
^0153250000000000*% 
00152000000000000*% 
^0151150000000000*% 

END*% 



START OF REL 



%IA 



0170000Q 
SEGMENT* DISK 
01701000 
01702000 
01703000 
01704000 
01705000 
01706000 
01707000 
01708000 
01709000 
01710000 
01711000 
01712000 
01713000 
01714000 
01715000 
017J6000 
01717000 
01718000 
01719000 
01720000 
01721000 
01722000 
01723000 
01724000 

01725000 
S 



T 0000*0 
ADDRESS a 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0002*0 
0003*1 
0005*0 
0006*0 
0007*1 
0010*0 
0016*0 
0017*1 
0017*1 
0017*2 
0019*0 
0020*0 
0021*0 
0022*0 
0023*0 
0024*0 
0025*0 
0026*0 
0027*0 

0028>0 



00212 



IZE« 0029 WORDS 



€ 



• 

• 

• 
• 

• 



DEFINE SINCOSBODY ~% 

IF X < 

BEG 

IF X Z P 

BEG 



IF X 



END 
> P 
BEG 



PI *» 

PIHAF" 

HALF it 

Kl 

K2 

K3 

K« 

K5 

K6 

MAXl 



END 
IF ABS(X 
P(X*DUP» 
x,QUP>Kl 
x# 1 ,0#+» 
: ! 8 g> 114 



IP 



j i :p 



j IP 



114 
115 
127 
125 
123 
121 
117 
115 
OOO 



THEN* 

IN X * *x; PCCHS) END** 

CP1) THEN* 

IN PCNQP)'* 

IF P(X/P(PI)*P(hALF)' 0UP3>PCMAXI) 

THEN PCUTERAL* 26 ' C0M); 
IF I * POLISH THEN P(CHS); 

X * X MOD P(PI);% 

',% 

CPIHAF) THEN* 
IN PCCHS);* 

X * X-P(PI);* 

X) < ,000001 THEN PCZxX*RTN);X 
,% 

l*NQP,x,K2>* , >T»x,K3#+#T»x,K4#"»#T>x,K5i 
»X#x,2*XCH#x,rtN);* 

43110375524210;* 

41444176652104;* 

540000000000001* 

71245234431113/* 

53270005320624;* 



PROCEDURE 



6400637634150;* 
4210421041102;* 
■1252525252524;* 
• 7777777777777;"' 



% 



SININTCX); VALUE X; REAL X;* 



BEGIN REAL Ts 
INTEGER 
LABEL PI 
LABEL Kl 
LABEL MA 
DEFINE L 

;sincosb 
end;* 



+2>z=+i;* 
i = t;* 

>pihaf>half;* 

»K2*K3*K4*K5#K6;% 

xi;* 

ITERAL = 4#; 

ody;* 





01800000 


T 


000010 




01801000 


T 


ooooio 




01802000 


T 


0000*0 




01803000 


T 


0000*0 




01804000 


T 


000010 




01805000 


T 


ooooio 


*WF 


01806000 


T 


000010 


*WF 


01807000 


T 


ooooio 


*WF 


01808000 


T 


000050 




01809000 


T 


0000*0 




01810000 


T 


0000*0 




01811000 


T 


000010 




01812000 


T 


OOOO'O 




01813000 


T 


0000*0 




01814000 


T 


0000*0 




01815000 


T 


OOOO'O 




01816000 


T 


0000*0 


m p T# 


01817000 


T 


0000*0 




01818000 


T 


OOOO'O 




01819000 


T 


0000*0 




01820000 


T 


OOOO'O 




01821000 


T 


OOOO'O 




01822000 


T 


0000*0 




01823000 


T 


0000*0 




01824000 


T 


0000*0 




01825000 


T 


0000*0 




01826000 


T 


OOOO'O 




01827000 


T 


OOOO'O 


*WF 


01828000 


T 


OOOO'O 




01829000 


T 


OOOO'O 




01830000 


T 


0000*0 


OF REL 


segment; DISK 


ADDRESS » 




01831000 


T 


0000*0 




01832000 


T 


0000*0 




01833000 


T 


0000*0 




01834000 


T 


OOOO'O 


*WF 


01835000 


T 


0000*0 


XWF 


01836000 


T 


0000*0 




01837000 


T 


OOOO'O 




01838000 


T 


0034*0 






SIZE* 0037 



00213 



WORDS 






PROCEDURE COSINT(X); VALUE X; REAL X;* 

BEGIN REAL T*+2,Z»+i;* 
INTEGER I=T;* 
LABEL PI, PIHAF ,HALF;* 
LABEL Ki,K2>K3*K4>K5*K6;* 
LABEL MAXi; 
DEFINE LITERAL ■ 5#> 
X «■ X + PCPIHAF #N0P»N0P>N0P>; r 

sincosbody;* 
end;* 



START OF REL 



XWF 

%WF 



01839000 

segment; DISK 

01840000 
01841000 
01842000 
01843000 
01844000 
01845000 
01846000 
01847000 
01848000 



T 0000*0 
ADDRESS m 00215 



T 
T 
T 
T 
T 
T 
T 
T 
T 



OOOO'O 
0000*0 
0000*0 
0000*0 
0000*0 
OOOO'O 
OOOO'O 
0002*0 
0036*0 



SIZE= 0039 WORDS 







• 

• 



• 



COMMENT ARCTAN INTRINSIC FOR ESPO^S 
REAL PROCEDURE ARCTANINT( XI ) ; % 



VALUE 

BEGIN REAL 

LABEL 

LABEL 



xi; real xi;% 
t=+i*d,pi2,arcy;% 

Ll*GNEL»PlHAF,A#8»ARCA,ARCB,TENM6;% 
Kl,K2#K3»K4*K5>K6*K7J% 
P(ONEL)#J% 



START OF REL 



DEFINE ONE s 

REAL X = XW% 

PCDIA 1,DIB 1 )}% 

IF (T * ABS(X)) > ONE THEN% 

BEGIN PI2 «■ P(PlHAF#x*TRB t)*% 
IF T > P(Ll) THEN PCX«-0)% 
ELSE P(ABS<X«--CqNE/X}));% 
T * P;% 
ENOJX 
IF T < PCTENM6) THEN PC X+PI2* RTN) }% 
IF T > PCKU THEN* 

BEGIN IF T < P(K2) THEN P(A,ARCA) ELSE 
D * P(X*TR8 1»«aRCY,8ND,TRB 1 ) J % 
X «• (X-D)/CDxX + ONE);X 
ENd?% 
PCX* DUP*% 

x*.T#SNOj"K3#x*K4» + »T>x,K5***T*x#K6*+*T>x*K7#-#T#x#0NE>+*% 

x#x,+,+,rtnj;% 



PCB,ARCB);% 



ONEL 

LI 

Kl 

l<2 

K3 

K4 

K5 

K6 

K7 



! ! 

: ; 
: : 
j : 
: : 



: : 
s ; 



P 



8 
1? 



PIHAF? J 
A 5 ! 

B * "t 

ARCA ?! 

ARCB JJ?9 
TENM6? ? *f? 
ENDU 



?(? 
IP 
• 8 

IP 



1H100OOOOOOOO0QJX 

0631000000000000;% 
1151210574175662;'% 
1154047010241407;% 
3165354424670553;% 
1167063634367006;% 
1151111104736450;% 
1151463146300126;% 
1152525252525235;% 
1141444176652104;% 
1152462675773223;% 
1155637726073171;% 
1152406627566472;% 
1155015457355165;% 
1232061573640554;% 



01900000 
01901000 

segment; disk 

01902000 
01903000 
01904000 
01905000 
01906000 
01907000 
01908000 
01909000 
01910000 
01911000 
01912000 
01913000 
01914000 
01915000 
01916000 
01917000 
01918000 
01919000 
01920000 
01921000 
01922000 
01923000 
01924000 
01925000 
01926000 
01927000 
01928000 
01929000 
01930000 
01931000 
01932000 
01933000 
01934000 
01935000 
01936000 
01937000 
01938000 
01939000 
S 



T 0000*0 
T 0000»0 
ADDRESS * 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



OOOO'O 
0000*0 
0000*0 
0000*0 

0000*0 

000010 
0000*0 
0001*2 

0003*0 

0004*3 

0006*3 

0009*0 

0009*2 

0009*2 

00UI3 

0012J2 

0015»3 

0017*2 

0020*1 

0020*1 

0020*3 

0026*2 

0027*3 

0029*0 

0030*0 

003l*0 

003210 

0033*0 

0034*0 

0035*0 

0036*0 

0037*0 

0038*0 

0039*0 

0040*0 

004l*0 

0042*0 

0043*0 



00217 



i 

I 
I 

i 

i 
i 
i 

i 



• 

• 



IZE= 0044 WORDS 



COMMENT LN INTRINSIC FOR ESPQ L ;% 
PROCEDURE L^INTCX)* VALUE X; REAL x;% 

START OF 
BEGIN LABEL L 1 »L2,L3,K 15, K 16, K \7 , K 18, K 19;% 

LABEL KQN, K 1, K2, K 3* K4, K5 # K6, K7 # K8> K 10 * K H, Kl 2, Kl 3, Kl 4;% 

LABEL Min;% 

DEFINE ONE = PCKON)#;% 



02000000 
02001000 
REL SEGMENT; DISK 
02002000 
02003000 
02004000 
02005000 



T 0000*0 

T 0000*0 
ADDRESS « 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 



00219 







IF X<0 THEN P(X*0*s,0UP»+,26.C0M); % ARGUMENT CHECK 
IF CX * ABSCX+P(MIN)))> P(Kl) THEN* 
IF X < PC K2> THEN* 

BEGIN PCO*0);« 
L3t P(X);% 

GO TO L2^% 

ENOU 
PCX.C3*634XCH2in + l2»DUP#K3*x»XCH#OUP» + );% 
IF £X*X&76C2iail7]) 2 PCK7) THEN BEGIN* 
IF X >P(K10) THEN BEGIN P(K14» + >K13 )) GO TO LI END;* 

BEGIN PCK12.+»K11)I GO TO LI END; END;% 
IF X 2 P(K4) THEN* 

BEGIN P(0NE>+*K8>; GO TO 11 END;* 
IF X < PCK2) THEN GO TO l3i% 
PCK6,+*K5);% 

l i s s pcx**>;% 

L2 S PC0NE>-,DUP>K14>+>* 
/#OUP*DUP*NOP*« 

x#,X>SNd*K15>x,K16*+»X»x,k17*+>X*x>K18*+*X#x*K19>**% 
y**#Kl4»+fXCHj»x# + **#RTN>;x 

M I N« > s?i 770000000000001;* 
kon" ?® i uioooooooooooo ;* 

Kl t » J91l5616575747526i;» 
K2 : * »PU41221327436077J% 
K4 8::?1142Q73716664320;% 
K3 «SS! 8 ll65053 1 077l6726U 
K5 S!i?U54664262770676;x 
K6 S * **» H54000000000000;* 
K7 * :s#H43373034355542;* 
K8 *H»ii52742653066l32Jt 
KIOM 191 14560 2266440557;% 
KU'*seil5l62l74i67lll3;* 

K 12! * 1 91141400000000000 ;« 
K13« : ;? 115 105225252 1677;% 

K14* M? 11 42000000000000;% 
K15* » I? 115 14066577270 33 *X 
K16S:j^ll5l6l5542107l07;% 
K 17 * «: f» 1152222224 3666 10;% 
K!8* * » P1153 146 3 14625377;* 
K19* :: 9 11 5525 25252525 30;% 

end;* 



%IA 



02006000 
02007000 
02008000 
02009000 
02010000 
O20UO0O 
02012000 
02013000 
02014000 
02015000 
02016000 
02017000 
02018000 
02019000 
02020000 
02021000 
02022000 
02023000 
02024000 
02025000 
02026000 
02027000 
02028000 
02029000 
02030000 
02031000 
02^32000 

02033000 
02034000 
02035000 
02036000 
02037000 
02038000 
02039000 
02040000 
02041000 
02042000 
02043000 
02044000 
02045000 
02046000 



T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



000010 
0003*0 
0005*0 
0006*1 

0007*1 
0007*2 

0008*0 
0008*0 
0011*3 
0014*2 
0017*0 

0018*1 
001910 
0020*3 
0022*0 
0022*3 
0023*2 
0024*3 
0025*3 
0030*2 
0032*3 
003410 
0035*0 
0036*0 
0037*0 
0038*0 
0039*0 

0040*0 
004l»0 
0042*0 
0043*0 
0044*0 
0045*0 
0046*0 
0047*0 
0048*0 
0049*0 
0050*0 
005i*0 
0052*0 
0053*0 



C 

« 



SIZE' 0054 WORDS 



REAL 



COMMENT 
PROCEDURE 



EXP INTRINSIC FOR 
EXPINT(X) ; VALUE 



espol;* 

X ; REAL 



x;% 



START OF REL 



BEGINS 

REAL Q * + 4* Z * + l* EX m +2, B«+3* Y=+5# T * +2;% 

LABEL K0*K1#K2#K3#K4»K5,K6#HALFJX 

LABEL MAX; 

IF X < P(KO) THEN P(RTN);% 

IF X>p(MAX) THEN P(3# 26* COM); 

PC X»Kl>x, ,X,SND# HALF>->.Z* ISN, CHS/ Xj> +# .X* SNp»X 



%WF 



02100000 
02101000 

segment; disk 
02102000 

02103000 
02104000 
02105000 
02106000 
02107000 
02108000 



T 0000*0 

T 0000*0 
ADDRESS * 



T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0001*3 
0003*3 



00221 



02109000 T 0007*1 







K6,+»X»x,DUP#B#+#B#Q#-.N0P#/#DUP#0#DEL»P.C3*6J&Y[l»2ll J#: 
Z>3»DIV*+* ,EX * SND> P & P[2 * 1 1 1 3 &EX C 3 M2 ? 6 J » % 

Z*3, MOD*0UF>+> ,EX, SND*0,* ) ;X 



IF P 



• 



KC* : * 
ki » : * 



K2J 

K 3! 

K5* 
K 6 1 J : 
HALF' 

max: s 



: 



END 



THENX 
BEGIN 
EX* x 



IF Z < THEN PC EX*/»CH5*RTN)JX 
)} END; P CRTN)J% 



9 3121520000000000 ;X 

<? 1141342521662454 jX 

* 1135326737175655 )% 

9 1102360633500106 ;X 

9 1075621717466364 ;X 

t? 1111554324131444 ;X 

@ 10720024H247315 }% 

P 1154000000000000 ;X 

1122360000000000 ; 

EXP INT ',% 



02110000 
02111000 
02112000 
02U3000 
02114000 
02115000 
02116000 
02117000 
02118000 
02119000 
02120000 
02121000 
02122000 
02123000 
02124000 
02125000 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SIZE 



001210 
001711 
002012 
002213 
002213 
0025*2 
0026*1 
0028*0 
0029*0 
0030*0 
003i>0 
0032*0 
0033*0 
0034*0 
0035*0 
0036*0 
• 0037 



WORDS 



PROCEDURE G0T0S0LVERINT(U»X*F#B)IX 

VALUE L'X'FjBJREAI L*X,BJARRAY Ft*3IX 
BEGIN IF I * 15 THEN 

L *■ U(F)C18I33U53&BC8|38H0]JX 
ENDJX 



START OF REL 



02200000 

segment; disk 

02201000 
02202000 
02203000 



T 0000*0 
ADDRESS * 
T 0000*0 
T 0000*0 
T 0000*3 



02204000 T 000313 



00223 



SIZE* 0004 WORDS 



REAL PROCEDURE MAXtNTCXm 



START 



VALUE X* REAL X*% 

BEGIN REAL RCW*+0, SIZE*+1» JUNK=+2J% 

POLISHCRCW^ FCX* CRCW3 INX NOT 1 INX 0* XCH* Sub, 0* X)IX 
WHILE SIZE>0 DO BEGIN PCDUP3JX 
JUNK «- *(PC f X) + SlZE);X 
IF POLlSH<(JUNK «■ JUNK) THEN PCDEL* 0UP3;% 

SIZE * size-i;x 

enq;x 
p0lish(rtn);% 

END MAXINTjX 



XWF 02300000 T 0000*0 

OF REL SEGMENT? DISK ADDRESS ■ ©0224 

XWF 02301000 T 0000*0 

XWF 02302000 T 0000*0 

XWF 02303000 T 0000*0 

XWF 02304000 T 0003*1 

XWF 02305000 T 0004*3 

XWF 02306000 T 0006*1 

XWF 02307000 T 0008*1 

XWF 02308000 T 0009*2 

XWF 02309000 T 0010*0 

XWF 02310000 T 0010*1 

SIZE- 0011 WORDS 



REAL PROCEDURE MININTCX);% 

VALUE X; REAL X*X 

BEGIN REAL RCW=+0, SIZE*+1» JUNKs+2;X 
PQLISH(RCW> FCX* CRCW3 INX NOT 1 
WHILE SIZE>0 DO BEGIN PCDUP);X 
JUNK * *CP( ,X)+SIZE);X 



START 



inx o» xch* sua* o* x);x 



IF PQLISH>(JUNK * JUNK) THEN PCDEL* DUP)>* 



XWF 

OF REL 

XWF 

XWF 

XWF 

XWF 

XWF 

XWF 



02400000 

segment; disk 

02401000 
02402000 
02403000 
02404000 
02405000 



T 0000*0 
ADORESS » 00225 



0000*0 
0000*0 
0000*0 
0003*1 
0004*3 



02406000 T 0006*1 



€1 



SIZE * SlZE-l;X 
ENQJX 

P0LI5H(RTN)JX 
END MININTIX 



XWF 


02407000 


T 


0008*1 


XWF 


02408000 


T 


0009«2 


XWF 


02409000 


T 


0010*0 


XWF 


02410000 


T 


0010*1 



SIZE* 0011 WORDS 



ARRAY SQRCECM* DESTC*3;X 



m 



m 
m 
m 



PROCEDURE SUPERM0VERINTC50RCE* DEST* AEXP)JX 

START 
VALUE AEXP; INTEGER AEXPJ 
BEGIN INTEGER T« + UX 

P0LlSH(S0RCE,C8:i0]# DEST , [8 5 10 3 ) }% 

IF P(DUP)<T THEN P(XCH);X 

IF PCOEL* DUP)>AEXP THEN T *■ AeXP;X 

IF T>0 THEN 

STREAM(P4«-P* P3«-P(DUP).C36|6J, P2«- CSORCECO 33 * Pi* [DEST £03 3 )JXWF 

BEGIN SI*P2; P3(DS«-32 WDS; D5«-32 WDS); DS*P4 WDS; END* 
END SUPERMOVERINTU 



XWF 


02500000 


T 


OQOO'O 


OF REL 


segment; disk 


ADDRESS * 


XWF 


02501000 


T 


000010 


XWF 


02502000 


T 


000010 


XWF 


02503000 


T 


0000*0 


XWF 


02504000 


T 


ooogio 


XWF 


02505000 


T 


0003*2 


XWF 


02506000 


T 


0005*3 


XWF 


02507000 


T 


0006*2 


XWF 


02508000 


T 


0009»2 


XWF 


02509000 


T 


001113 



00226 



Size* 0012 words 



PROCEDURE COBOLFCR; 



BEGIN 



REAL CODE 



NAME FLOC 
REAL MKSCW 



a-i; 



s ™2* 

3*3; 



REAL CLOSELOCK =-4J 



PRT DESCRIPTORS 

REAL COBOLCQNTROl *23, 

COBOLINDF.X =22* 

CQBOLIO sl4* 

FOR s!2* 

PERFORMGEN =13i 

REAL INTINT =51 

NAME MEM »2; 

ARRAY FPB *3E*3# 

PGUSE ?24C*3 

LOCALS 

REAL REEL; 
ARRAY FIBC*3; 

REAL i; 



X 
% 

% 
% 
% 
% 
% 
% 
% 
% 
% 

% 
% 

% 

% 
% 
% 
% 
% 
% 
% 
% 
}% 
% 

% 
% 
% 



OalNVA 
3=0PEN 
7»CL0S 
POINTE 
s MkSC 

» reel 

HOW TO 

a 

1 » 
2. ** 
4 » 
A * 
7 * 

64 * 



START OF REL 

LID,1=0PEN INPUT*2«0PEN REV IN 
0UT,4«CL0SE>5*0PEN I*0*6sSQRT 

E CRUNCH, 16=0PENl#17=CLOSEi 

R TO FIB DESCRIPTOR 

W :N0 REEL** 1 FOR REEL CLOSE 
# FOR REEL, OPEN, 
CLOSE THE FILE 

REWIND (RETAIN) 

NO REWIND (RETAIN) 

LOCK (SAVE) 

PURGE LOCK (RELEASE + PURGE) 

RELEASE LOCK (RELEASE + LOCK) 

RELEASE (LOOK AT SAVE FACTOR) 

CRUNCH 



COBOL 61* FOR CALLING USE 
COBOL 61* FOR CALLING USE 
COBOL READ WRITE 
COBOL FCR 

COBOL 68* FOR PERFORMING 
ARRAY DEC INTRINSIC 
DUMMY DATA DESCRIPTOR 
FILE PARAMETER BLOCK 



ROUTINES 
ROUTINES 



USE ROUTNS 



USE ROUTINES ARRAY 



C0B6IU3 
C0B68* 6 



WDS 
WDS 



MUST BE HERE FOR MKSCW DIDDLE 
FILE INFO BLOCK 
INDEX + TEMPORARY 



02600000 
SEGMENT; DISK 
02600100 
02600110 
02600120 
02600200 
02600300 
02600400 
02600410 
02600420 
02600430 
02600450 
02600470 
02600480 

02600500 
02600510 
08600515 
02600600 
02600650 
02600700 
02600800 
02600900 
02600990 
02600994 
02600995 
02601000 
02601100 
02601400 
02601500 
02601600 
02601700 
02601800 



T 0000*0 
ADDRESS a 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 



00227 



NAME 100=1.} 

real ix; 

ARRAY 13LOJ; 
REAU MQTSERL.J 
INTEGER PU1*PU2* 
FUl*FU2* 
REAL RPU1 = PU1* 

RPU2 * PU2J 
REAL T* 

TEST/ 



SVI 

DEFINE 
AF 



'18* 

C0B68/ 



% 10 DESCRIPTORS FOR CLOSE 

% INDEX TO FPB 

3LABEL FOR BUILDLABEL+HEADER FOR CLOSE 

% SET TRUE FOR RANDOM & 10 FILES 

* USED BY 8UILDLABEL + USERS. DONT MOVE 
% USED BY BUILDLABEL * USERS, DONT MOVE 
% USED BY BUILDLABEL 

% USED BY BUILDLABEL 
% TEMPORARY 

% TRUE WHEN CALLING US£R$*USERS68 SAYS 

% TEST FOR BEG OR END FILE USE ROUTINE 

TRUE IF C0B0L68 FIB IS TO BE SAVED 

* TRUE IF THIS IS COBOL 68 



= C 12 : 123#, 



% C0B68J FILE USE ROUTINE 



ALGOLIOC ALGOL IQ1)=P([ 100 3* ALGOL IOl*li*COM*DEL*DEL>** 



ARR 

BACKSPACE 

BCOUNT 

BF 

BOUNDED 

BREAKFAIL 

BUFFERSIZE 

BUFREQ 

BUFTOP 

BRR 



C36tl23#* 

PCC-D* CFLOCC333 

FIBC63#» 

tl!tl]l» 
FlBC93tC2!13#, 



ROUTINE 



% C0B68: REEL USE 

INX 0*9*ll*CQM)#* 

% BLOCK COUNT 

% CQB68* FILE USE 

% TRUE IF BOUNDED 
P(FIBU53,i;25t5 3*cm)x4*i2*CQM)#*%BR OUT 
FIBC1S3 .C3I 153## * BUFFER SIZE REQUESTED 
FIBC133.U:93#* % NO, OF BUFFERS REQUESTED 
FI8[161#*% COPY OF TOP IQD?P0INTS TO BEG 8UFFR 
C24U23#, % COB685 REEL USE ROUTINE 



ROUTINE 
FROM ABOVE 
FAIL 



CALLHASHCCALLHASHl):*PCMKS,FLaC,*FI8[8 3,CALLHASHl,CQC)#, 



CLOSE 

CLOSED 

CLOSEDHERE 

CLOSEDRET 

COBOLCLOSE 

COBOLFILE 

COBOLFILBIT 

COBOLOPENIN 

COBOLOPENOUT 

COUNT 

CURRENTREEL 

OIRECTION 

DISCARDWA 

DISK 

DISKR 

DISKS 

DISKP 

ENDFILE 

EOF 

EORF 

EORRERUN 

FPBXDONE 



s 4#* 

=CFI8E53»C4i;2J/0)#*%FILE CLOSED 

* FlBt8]fClHJ#, % C0868 CLOSE HERE WAS DONE 
s «»20#* % CLOSED RETAINED 

= PCCLOSELOCK&REEL C 2 * 4711 3*FLDC# CODE* 1 3*CQM* 

DEL*DEL*DEL}#* 
« FI3U33#, % ON SAYS FILE IS COBOL 
= FIBC133 .C47I 

* P(REEL>FLQC*C0DE»13*CQM,,I***DEL*0EL)** 
= P C REEL 'FLQC* CODE* 13* COM, DEL* DEL* DEL )#* 

- FIBC123#* % NOTSERL t NO, OF CURRENT BLOCK 
% SERIAL IN(0UT)8 RECORD COUNT WITHIN BLOCK 

- FIB[133,C28lloJ##* CURRENT REEL NUMBER 

* CFIBC13J,[25I1])#,» 1*REVERSE*0*FQRWARD 
s P£M£M OR <(*RcPRT),[FFJ),3*C0M,DEL)#* 

s FI8t43.C8t43s4#* 

DISK RANDOM (FPB) 
DISK SERIAL (FPB) 
DISK PROTECT(FPB) 
RECOGNIZED END OF FILE 
EOF BIT IN IOD 
SENTINEL? I'EOR 0»EOF 
RERUNM'OUTPUT TAPE* 2«SCRCH 
C13II13 IS FPB INDEX 



10#* 
12#* 
26** 
FIBC5]«t40l 13## 

C27lU#, % 

C42J63** * 

FIBC43,[3l23#,*EOR 
FIBC43»C12*l3#* % 



FCRCLOSE(FCRCLOSEU*PCMKS*FCRCLOSEl*0*tFLOC3*4*FCR)#* 



FCROPENOUT 
FILIO 
FPBTYPE 
GETDISKROW 



P(MKS*T,CFLOC3*3*FCR)#* 
FIBC133.C22U3** % FILE OPEN 10 
FPBUX+33.U3}53#*% FPB FILE TYPE 
P(FPBUX + 3 3*FPBEIX3*FPBCIX+13*10'LBL* 
4*H*C0M*0EL*DEL*DEL*DEL'DEL#DEL)#* 



02601900 

02601950 

02602000 

02602050 

02602100 

02602150 

02602199 

02602200 

02602250 

02602300 

02602350 

02602360 

02602400 

02602410 

02602430 

02602440 

02602450 

02602455 

02602460 

02602470 

02602480 

02602490 

02602500 

02602510 

02602520 

02602530 

02602550 

02602560 

02602570 

02602575 

02602580 

02602585 

02602586 

02602590 

02602600 

02602610 

02602620 

02602630 

02602640 

02602650 

02602660 

02602670 

02602680 

02602690 

02602700 

02602705 
02602710 
02602720 
02602730 
02602740 
02602770 
02602780 
02602790 
02602795 
02602798 
02602800 
02602805 



T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

C 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 

Q000*0 
QOOO'O 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 



• 
• 
• 



$ SET 



$ 
$ 



POP 
SET 



HASH 

HEADERPTR 

HNMROwS 

HNMSZRS 

INF I IE 

iQDflNE 
IOERRf IQERR1) 

LABELED 

LAREQ 

LASTIO 

LBLPTR 

LOCK 

LSU8L 

LSUBU 

MABUSF 

MAXR 

MAXREC 

MTNREC 

Mf 

NMSZROWS 

NDAIT 

NOREW 

NOTCLOSED 

NOTFlRSTREEL 

NOTINANOOPEN 

NUMBUFF 

numRec 

OPENIN 

OPENIO 

OPENQUT 

OPTIONAL 

OUTAP 

P3TT 

PBT 

performuse 

PRINTFILE 

PURGEREEL 

PURGE 

RANDOM 

RCOUNT 

RCPRT 

RECSPER8LK 

REDECWA 

RELEASE 

RESETPARITY 

RESETREADBIT 

REWIND 

SEGSPEROW 

SEGSPBLK 
OMIT » NQTCTIME 

SLEEPCM 
QMIT 
OMIT * TI^ESHAR 

SORT 

SQRTFILE 



■ <FIBCe3/0)#, 
= FIBCH3## 
* LBL[93#* 



NOT 
FIB 
FLO 
PCO 
NOT 
FIB 
FIB 
FLO 
2#» 
FIB 
FIB 
FIB 
FIB 
FIB 
FIB 
2t, 
FIB 
FIB 
1#» 
FIB 
FIB 
FIB 
FIB 
FIB 
1## 
5t, 
3*' 
FIB 
T#> 
C2? 
7#, 
PCM 
FIB 
PC C 
4## 
FIB 
FIB 
FIB 
L8L 
PCM 



% 
% 



C0861* HASH ROUTINES PRESNT 
DESC. FOR DISK FILE HEADER 
HEADERi NUMBER OF ROWS 
CDO NOT CHANGE) 
HEADER; SIZE OF ROWS 

FILE OPEN INPUT 

DONE BIT ON IN IOD 



SERL#* 

U3J.C27in 
C [ I +2 3 C19i 

,FU0C*I0ERR1#17»C0M)«, X CALL IOERR-DQNT OS 
UNLABELED** 

t53.ci7in#» 

[133, U6J13** 
CC13#, 



% LABEL EQUATED FROM DISK 
% 1=LAST WAS PHYSICAL READ 
% LABEL DESCRIPTOR 



C33#* 

E4].[1UJ#, 
[183[8*38*l 
tl83,CCF3#, 
[183, [FF)#, 

C81 • C20« 28] 
C203.t3«n# 

C53,[4i;23x 
£53 »C38:13# 

[53, [41*33/ 
C133 t tlO»93 



% 
% 
% 

% 



## % 

» % 

% 

» % 
1*>X 



DISKJ LOWER BOUND RECORD NO 
DISK: UPPER BOUND RECORD NO 
USE ROUTINES PRESENT 
% MAX REC SZ FOR CONCATS 
MAXIMUM RECORD LENGTH 
MINIMUM RECORD SIZE 

MAGNETIC TAPE 

DISKJ NMs[20!S3>SZ*[25?233 

AIT FOR «A WAS DESTROYED 

NO REWIND 

FILE NOT CLOSED 

=1 IFF CURRENTREELX1ST REEL 

FILE NOTCINPUT & OPEN) 

NO, OF BUFFERS ASSIGNED 

NO. OF RECORDS PER BLOCK 



C53.C39U3#i 



KS#CFIBJ>T, 

[203 *, 
FLOC[333&^2 

[43. [29*13* 
C73#» 

C203tCFF]## 
[03 . t 30« 123 

ks*rcprt#ma 



% REEL OPTIONAL AND ABSENT 
% EOR RERUN ON OUTPUT TAPE 
% PRESENCE BIT 

0*PERFORMGEN)## 

% CF*1 IS PRINTFILE 
3CCTF3#20,ll,COM,DEL*DEL*DEL)#* 

> % RANDOM ACCESS IS THE ORDER 
% NO. OF RECORDS INTO FILE 
% PRT OF DESC POINTING TO REC 
t» % HEADER* RECORDS PER BLOCK 
XRECMM'IMNTINT)** % DECLARE 
% SAVE ARRAY FOR WORK ARIA 



3 7#> 

=> FLOCC33* C*P(0 

* 0[24*24*U#* 

? 0## 

s L8L[83#* 

» LBL[03tt42«63# 
SHARING) 

* 36>C0M#, 



UP))«0t28l28*13** 
% USED TO TURN 



% RESET PARITY 
OFF READ BIT 



% HEADERJSEGMENTS PER ROW 
* HEADERJSEGMENTS PER BLOCK 

% SLEEP COMUNICATE 



ING 

* CFIBUl 



[7*13 OR FIB[18].C1«13)#» 



02602810 
02602820 
02602830 
02602831 
02602840 
02602850 
02602860 
02602865 
02602870 
02602880 
02602885 
02602890 
02602900 
02602910 
02602920 
02602930 
02602945 
02602950 
02602952 
02602955 
02602960 
02602965 
02602970 
02602980 
02602985 
02602990 
02603000 
02603010 
02603020 
02603025 
02603030 
02603040 
02603050 
02603051 
02603055 
02603060 
02603070 
02603080 

02603090 
02603100 
02603110 
02603115 
02603120 
02603130 
02603140 
02603200 
02603202 
02603205 
02603210 
02603220 
02603230 
02603232 
02603235 
02603236 
02603237 
02603240 
02603250 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



000010 
0000*0 

0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

ooooio 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
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SZF 
TECH 

TECHB 
TECHC 
TERMCTERM1) 

UNITYPE 

UNLABELED 

WAITIO 

wordsleft 
writeparity 
writback 
writeaftereqf 



• 



• C8 8 103#* 

' FIBC53.[46*23#, 

•■ 2*> % TECHNIQUE B 

1 3#> % TECHNIQUE C 

■ PU#FLQC»TERMl#l7*C0M)## * TERMINATE ON 10 ERR 

' FLOCC33*, % TOP IOD 

: CFIBC4l.C8»4])#» XASSNO INTERNAL HARDWARE TYPE 

: F1BC4].C2*U** * UNLABELED FILE 

P UFLQCCI +2 ]3, 02000000000, SLEEPCM, DEL* DEL >#> 
FIBC173#> * NO. OF WORDS LEFT IN BLOCK 
FI8C5).C3*1]#, % INDICATES FORCED REELSWlTCH 
; FIBtl33.C23Jt3#* * WRITE BLOCK BACK ON 10 

„ .,,. ,w, W! .u — r - FIBC13.],C44I2]#; 
LABEL LlNVAHD*LOPENIN#LOPREVlN,LOPeNOUT»LCLOSE#LOPENlO*LSORT» 

L0PEN1*LCL0SE1*STARTL*EXIT»TSTBRK*8STP;% 
SWITCH TYPE * LlNvALID»L0PENIN,LOPREVlN,LOPENOuT»tCLOSE#L0PENiO» 

lsqrt;% 
subroutine bulldlabelu 

BEGINS 
I * IX t% 
FLQCC1 3*FLAQC1*CIF FPB C I +3 3 , [43 J 53*1 THEN 19 ELSE FLOC E 1 3 , £8s 10 

3+4)C8*38*lO38,(FL0C INX 1 ) 1 18 * 33 J 153 )l% 
P(FL0CC1)»0*CQC»DCU)I* 

FL0CC1]*C2 INX FLOCC13)&CFLOCC13,C8:iO3-4)[8»38;i03)X 
STREAMC A * FU2«-P< 0* it COM ) , B*FlB E4 3 * C* C PU1 3 )i% 

BEGIN SI* LOC AISI*SI+3;OS*20CTIDS*30CTI* 
3I*L0C Bi SI*Sl+5; DS*30CT; END** 
FU1*(PU2*PU2 + FU1 + 3649)M0D 365 + CPU2 DIV 365+PUl-l0)xl00Q+U % 

% at this point fu1 contains purge oate(binary) an fu2«?date(decimal )% 
streamck*0:a*currentreel#b*fp8cl+2 3>; begin* 
di*loc k;si*loc a;os*30ec;si*loc b;si*si+3?ds*5chr end;* 
if crpu1*p).c1u73*0 then 
if crpu1«-fpbci+2j),[1u73»0 then rpu 1 , [ 17 8 1 3 *1 i 
if rpu1, [18*303*0 then rpu1 , c 18 * 303 *fu2; 
if crpu2»»fpb[i*33).c1»53«0 then rpu2, [ 5 * 1 3 * *1 j 
stream<k*o*pui);begin di*loc k;si*loc pui;ds*3oct end;* 
reel*p; currentreel*reel; 

5TREAMCA*CFPBCn3*8*PUl*C*PU2»D«-FUl#X 

Q*IF CT*FP8[I + 33.[43J53)mO OR T=12 OR T*26 THEN 

P(CHEADERPTR3»LOD»7>COCM> + ) ELSE 0# 
G*FLQCCl3. [8*103-8*% 
F*IF REEL^l THEN F IBE43 . C4 ! 1 3 ELSE 

begin ds*8lit" label "j» 
si«-a; os*2 wds; si*lqc b; ds*wds; 
DiiaDi + iJosis chr; su*loc d; DS$*5 
0s*lit"0«; %sentinal% 
ds*5lit"0"j% block*count* 
si*loc q;ds*7dec; *rec*cquntx 
si*loc f;si*si+7IDS*chr; % 
DS*5LIT»0 M J x physical tape 
os*6lit»'o m ;% 



o,e*floc[U); 

si*loc c;* 
dec;* 



mem-dunp key* 

NO,* 



);* 



END 



G(DS*8LIT ,, 

end;* 
subroutine gouse;* 

BEGIN* 

COBOLINDEX * T.C26M03U 

PC MKS* T. [38*103* C COBOLCONTROL 3 ) ; % 



02603260 

02603270 

02603280 

02603290 

02603300 

02603310 

02603330 

02603340 

02603360 

02603370 

02603375 

02603380 

02603385 

02603390 

02603395 

02603400 

02603450 

02603500 

02603600 

02603700 

02603800 

02603900 

02604000 

02604100 

02604200 

02604300 

02604400 

02604500 

02604600 

02604700 

02604800 

02604900 

02605000 

02605100 

02605200 

02605300 

02605400 

02605500 

02605600 

02605700 

02605900 

02606000 

02S06100 

02606200 

02606300 

02606400 

02606500 

02606600 

02606700 

02606800 

02606900 

02607000 

02607100 

02607200 

02607300 

02607400 

02607500 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0001*0 

0001*0 

0001*3 

0006* 1 

0010*2 

0012*1 

0017*3 

0020*1 

0021*1 

0022*1 

0028*0 

0028*0 

0031*0 

0032*3 

0034*1 

0039*2 

0043*0 

0047*3 

0050*0 

0053*0 

0054*2 

0059*0 

0062*0 

0064*0 

0068*1 

0069*2 

0070*3 

0071*3 

0072*1 

0073*1 

0073*3 

0074*2 

0075*2 

0076*2 

0078*2 

0080*0 

0080*0 

0080*0 

0081*1 



callgouse; 



• 



end;% 

SUBROUTINE 
BEGIN 

IF I OR TEST THEN 
BEGIN IF(T*P6USeCI3,C 1 S233 >/ 
lF(T*PGuSECI].t2<H2«])^ 

end; 

end callgouse; 
subroutine callgouser; 

BEGIN 

IF I OR TEST THEN 
BEGIN IF CT*FlBtn,C 1*233)* ( 

IF CT*Fl8n3. [24*2433* C 

end; 

end callgouser; 
subroutine users; 

BEGIN 

I *• pui; 

IF (I<-PU2)>0 THEN 

I *■ fui; 

if (i*FU2)>o Then 
end users; 
subroutine g0use68; 

begin perfqrmuse; Eno; 

SUBROUTINE USERS68; 
BEGIN 

TEST THEN 
BEGIN % CHECK 

CT«-FI8CFUi 3 # 8F )XO 
CT*FIBCFUl3.AF)X0 . 
CT«-PGUSECPU13.BF)*0 
(T*PGUSECPUl3 f AF)X0 



THEN 
THEN 



GOUSEI 

gouse; 



callgouse; 
callgouse; 
callgouser; 

CAlLGOUSer; 



then 

THEN 



gquse; 
gouse; 



if 

i 

IF 
IF 
IF 

IF 

end; 

IF 
BEGIN 

IF 
IF 
IF 
IF 



FOR FILE USE ROUTINES 
THEN 60USE68; 
THEN G0USE68; 

THEN G0USE68; 

THEN G0USE68; 



PU2>0 THEN 

% NOT DISK* CHECK FOR REEL USE ROUTINES 
(T«-FIBCFU13 ,8RR)*0 THEN G0USE68; 
CT<-FIBCFU13,ARR)^0 THEN G0USE68; 
CT<-PGUSE[PUl3»BRR)/0 THEN G0USE68; 
CT*PGUSECPUl3,ARR)X0 THEN G0USE68; 



end; 

end users68; 

%**************START HE 

REEL * IF PCMKSCW>TOP»XCH,DEL) THEN 

C0B68 «- CFIB«-*FL0C).SZF*22;3 

IF CODEslS THEN BEGIN C0DE*=4j SVFI8**U 

IF NOT FPBXDONE THEN FIB[4 3 , 1 12 * 123 

(CFlB£4],Cl2U2]-l)xETRUNG)*l 

IF NOT C0B68 THEN 
IF REEL>9 THEN* 
BEGIN 

STREAMCK«-0»L<-REEL);« 
BEGIN SI*LOC L; SI*Si+Sl« 

di*loc <; ds<-3 oct** 

end;* 

REEL <- P;% 

end;% 

IX * FlBE4J«C13Mim INDEX TO FPB 



RE* 

MKSCW 



***** 

else on 



end; 

t 361478131% 



% CONVERT REEL NO. TO OCTAL 



02607600 
02607700 
02607800 
02607900 
02608000 
02608100 
02608200 
02608300 
02608310 
02608320 
02608330 
02608340 
02608350 
02608360 
02608370 
02608400 
02608500 
02608600 
02608700 

02608800 
02608900 
02609000 
02609005 
02609006 
02609010 
02609020 
02609030 
02609040 

02609050 
02609060 
02609070 
02609080 
02609090 
02609100 
02609HO 
02609120 
02609130 
02609140 
02609150 
02609160 
02609170 
02610150 
02610200 
02610300 
02610310 
02610400 
02610500 
02610550 
02610600 
02610700 
02610800 
02610900 
02611000 
02611100 
026H200 

02611300 
02611370 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

C 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 



0082*2 
008213 
0083*0 

0083*0 
0083*3 
0088*0 
0092*0 
0092*0 
0092*1 
0093»0 
0093*0 
0093*3 
0098*0 
0102*0 
0102*0 
0102*1 
0103*0 
0103*0 
0105*0 

0108*0 
0110*0 
0113*0 
0113*1 
0114*0 
0115*3 
0116*0 
0116*0 
0116*1 

0116*3 

0120*0 

0124*0 

0128*0 

0132*0 

0132*0 

0132*3 

0133*1 

0137*0 

0141*0 

0145*0 

0149*0 

0149*0 

0149*1 

0149*1 

0156*2 

0159*0 

0161*3 

0164*2 

0168*3 

0169*1 

0170*2 

0171*0 

0172*1 

0172*3 

0173ti 

0173*2 

0174*0 
0174*0 







i 



IF 



CODEeOPENlO THEN 
AND NOT CDB68 THEN 



IF 
IF 



cooexclose then* 
if (t«-fpbtype)*diskr qr t*diskp or 
begin if ct=diskr or t=diskp) 
bufreq*i; notseRl«-true; 

END ELSE 

IF T<3 OR T*ll OR (T GE9 7 AND T<10) THEN 
IF FIBC83.C20»5]>0 THEN % HAS BEEN LABEQ FRM DISK 
BEGIN NMSZROWS*0* LABEQ * TRUE; ENOJ* 

CODE-SORT THEN GO TO LSORTj* 

CODE/CLOSE THEN* 
BEGIN 

FIBC133.C19S5] «Q}% 

IF- T*DISKR OR T*DISKs OR T*DISKP THEN* TECH 

IF TECH>1 THEN TERM(30)J * VALID ON DISK 



IF CQ368 THEN 

END** 

NIJM8UFF «■ BuFREO?* 



B & 
*CJC 



C NOT 
1031 



IF TECH^TECHC THEN MlNREC*MAxR£C; 



STARTL** 

IF CQDE>5 



THEN 



TO 



IF C0DEsl6 THEN Go TO 
IF C0DE-I7 THEN GO TO 
TYPECCDDE3;* 



L0PEN1 ELSE* 
LCL0SE1 ELSE 



TERM(25)J% 



GO 

lopfnios* 

code <• qpenini* 

FILIO * II* 

GO TO LOPENINJ* 
LCPREVIN** 

IF (CT«-TECH) = TECHC) 
LOPENIN 

IF 

IF 

IF 



OR CT=TECHb AND NUMREC^l) THEN TERMC5)! 



• 

• 
• 



NOTCLOSED THEN TERM( 2xCQDE*l ) I % 

REEL = THEN REEL «■ CURRENTReEL ELSE CURRENTREEL * REEL? 
(T<-FP8TYPE) = DISKR OR T-DISKS OR T*DISKP THEN 
BEGIN* 

01 % SINCE ITS INPUT 
THEN * UPPER BOUND 

LSUBU «• *P(DUP)"i; BOUNDED * TRUE* END* 
THEN LSUBL * *PCDUP)«i;x 
WRITEAFTEREQF *• Q}% 

BCOUNT * IF (RCOUNT*LSUBL)»0 THEN ELSE % STARTING 
CRCOUNT-l) OIV NUMREC * It % BLOCK 

eno;% 

* store boolean result in i* true for 

* LABELED AND NOT SORT FILE ON OPEN IN 



NMSZROWS ♦ 

IF LSUBU/O 

BEGIN 

IF LSUBL^O 



C080L0PENINI 



IF C0B68 THEN* 
BEGIN* 

IF NOAIT THEN* 
BEGIN* 

REDECWAI* 

NOAIT * 0|? 

end;* 

END;* 
IF DISK THEN* 
BEGIN* 

IF NOT C0B68 THEN 

IF RANDOM THEN TIP <- I I NX TlPl* DISK AOOR IN WRD 1 

BUILDLABELI* 

IF MABUSE OR NOT C0B68 THEN* 

BEGIN * BEGINNING INPUT/IO FILE 



02611390 

02611400 

02611410 

02611430 

02611440 

026U4S0 

02611480 

02611490 

02611495 

02611500 

02611510 

02611610 

02611620 

02611630 

02611675 

026H680 

02611700 

02611800 

02611900 

02612000 

02612100 

02612200 

02612300 

02612400 

02612500 

02612600 

02612700 

02612800 

02612900 

02613600 

02614200 

02614300 

02614400 

02614500 

02614600 

02614700 

02614750 

02614800 

02614900 

02615000 

02615100 

02615105 

02615110 

02615115 

02615120 

02615125 

02615130 

02615133 

02615135 

02615140 

02615170 

02615200 

02615250 

02615300 

02615400 

02615500 

02615600 



T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



017512 
0176*1 
018H1 
018411 
0188*0 
0188»0 
0192*1 
0194*1 
0199*3 
020110 
020113 
0202J1 

0204*3 
0207*2 
021111 
0216*3 
0216*3 
0220*0 
0220*0 
0222*0 
0225*0 

0229*2 
0229*2 
0230*1 
0232*3 
0233*1 
0233*1 
0239*1 
0239*1 
0243*2 
0249*1 
0253*3 
0254*1 
0256*3 
025713 
026213 
0266*1 
0268*3 
0272*2 
0275*1 
0275*1 
0277*2 
0277*2 
0277*3 
0278*1 

0279*1 
0279*3 
0283*1 
0285*3 
0285*3 
0285*3 
0287*1 
0287*3 
0288*1 
0293*0 
0294*0 
0295*3 



• 



# 



FU1* 01 TEST * li PU2 «- FU2 «■ *i; 

if cos68 then begin pui * axfilicux 

USERS68; END* 
ELSE BEGIN Pui *• 10*FILI0; USERS; END** 
END/% 
IF C0868 THEN 
BEGIN 

BCOUNT «■ C IF RANDOM THEN NOT 

ELSE RCOUNT DIV NUMREC); 
COUNT«-BCQUNT ♦ CNUMBUFF-l)*FIBC53EJ»44ll)j 
END ELSE 
BEGIN IF NOTSERL THEN 

tip <- (buffersize + 1> inx tip & maxri 
count * if notserl then -1 else qj 
resetparity; 



END 



%TR 1476 
%TR 1476 
SSTR 1476 
%TR 1476 
*TR 1476 



• 



IF 
IF 
IF 
IF 



EN 
HASH 
NOT 
(MAB 
NOT 

BE 



EN 
GO TO T 
LOPENOUTt% 

IF NOTC 

IF 

IF 

IF 



IF 



CLOS 
REEL 
(T*F 

TH 
T = OI 

BE 



GO to exit;* 

D DISkJS 

THEN IF NOT WRlTEPARlTY THEN CALLHASHC2); 
OPTIONAL THEN 

USE OR NOT C0868) AND I THEN X LABELED AND NOT SORT 
WRlTEPARlTY THEN 
GIN * BEGINNING INPUT FILE/REEL 

PUI * FU1 «■ 0* TEST * CURRENTREEL = U% 

PU2 * FU2 «• 11% 

IF C0868 THEN USERS68 ELSE USERS;* 

o;% 
stbrk;* 

losed then term(6).!% 

EDHERE THEN BEGIN CLOSEDHERE«-0; GO LOPENH ENDU 

*0 THEN CURRENTREEL+REEL** FIXES OPEN OUT REEL DATA-NAME 

PBTYPE)*5 OR T=8 OR T*9 % UNLABELED SPEC UNIT* PT* OR MT 

EN UNLABELED *■ \'»% 

SKR OR T=DISKS OR T=DISKP THEN 

GIN* 

if lsu8ux0 then begin lsubu «■ *p(dup)-lh 
bounded «- true; end;* 

IF LSUBLXO THEN LSUBl * *P(DUP)-U* 
BCOUNT «• CRCOUNT«-LSUBL) DIV NUMREC;* 
IF C0B68 AND NMSZROWS * THEN % OISK 
IF NOT DISK THEN % CLBL 

NMSZROWS *■ 100&2OC2O843I53; * 20 ROWS 100 RECS 



DEFAULT IS 
EQU ONLY) 



ELSE 



EN 
IF 

BE 



0% 

LA 
GIN 



enO;% 



8ELED THEN* 
* 

burdlabel;* 

if not sqrtfile then* 

begin if hash then callhashc 2 ) ; * 

if mabuse or not c0b68 then%beg out file/rl 
begin test <• reel'u fu1 * 0; pu2 * 5} 
if c0b68 then* 

begin pu1*2; users68; end* 
else begin pu1*4; fu2*1 j users;end; 
end;* 
end;* 



02615700 
02615800 
02615900 
02616000 
02616100 
02616140 
02616160 
02616180 
02616200 
02616220 
02616240 
02616260 
02616300 
02616400 
02616450 
02616470 
02616500 
02616600 
02616700 
02616750 
02616800 
02616850 
02616900 
02617000 
02617100 
02617200 
02617300 
02617400 
02617500 
02617600 
02617700 
02618500 
02618550 
02618600 
02618650 
02618700 
02618750 
02618800 
02618900 
02619000 
02619004 
02619005 
02619006 
02619010 
02619020 
02619100 
02619200 
02619300 
02619400 
02619410 
02619420 
02619430 
02619500 
02619600 
02619700 
02619800 
02619900 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 



029911 
0302*0 

0303*0 
0307*0 
0307I0 
0307*1 
0307*3 
0309*3 
0312*2 
0317*0 
0317*0 
0317*3 
0323*2 
0326*2 
0329*1 
0329*1 
0329*3 
0329*3 
0334*3 
0336*0 
0338*3 
0340*2 
0341*0 
0344*1 
0345*2 
0349*0 
0349*0 
0349*2 
0349*2 
035213 
0357*1 
0361*0 
0365*0 
0368*2 
0371*1 
037l»3 
0375*1 
0377*3 
0381*1 

038412 

0386*2 
0388*3 
0392*3 
0392*3 
0394*2 
0395*0 
0396*0 
0398*2 
0402* 1 
0404*0 
0406*3 
0407*2 
0410*0 
0413*0 
0413*0 
0413*0 



t 







• 



COBOLOPENOUT;* 

IF 00868 THEN * MOVE WA TO BUF.SAVE WA ADDRt POINT PRT TO BUFF 
BEGIN* 

IF NOAIT THEN* 
BEGIN? 

reoecwA;* 

NOAIT *■ Of% 

end;* 
if not (disk) then 

BEGIN WORQSLEFT * BUFFERSIZe; 

PRINTFILE * P(OUP»LOO#CFIBC«].C8U3)» 
P<DUP)sX,PcXCH#DUP>s7.P(XCH>«12»0R»0R#CCX>J 
END UNDISK; * t»lP# 7sPBT# 12*PBD 
END C0868ING; 
IF DISK THEN* 
BEGIN* 

IF RANDOM THEN 

IF C0B68 ThEN BCOUNT «■ NOT 
ELSE TIP * 1 INX TIP; 
BUILDLA8ELU 
L8L «• *tHEADERPTR3;% 
LBL[7] «• -in 
IF MA8USE OR NOT C0B68 THEN* 

BEGIN * BEGINNING OUTPUT FILE 

FU1 * o; TEST ♦ \t PU2 «• FU2 * *U 
IF C0B68 THEN BEGIN PU1 * 2} USERS68; END 
ELSE BEGIN pUl * 4; USERS; END; 
END;* 
IF NOT C0868 THEN 
BEGIN 

resetparity;* 
if notserl then* 

BEGIN* 

IF UNITYPE »ft AND NOT UNLABELED AND NOT SORTFlLE THEN *TR»90 
TIP «• (BUFFERSIZE + 1> INX TIP & MAXR; *TR 1476 
BUFTOP «• (*P(DUP)) & 1CZ4I47I13J *TR 1476 

END end; 
end disk;* 

IF NOT C0B68 THEN COUNT * IF NOTSERL THEN -1 ELSE NUMREC; 
TSTfiRK:* 

IF (T<-EORRERUN)XO AND CURRENTREELX1 THEN IF BREAKFAIL AND OUTAP 
THEN BEGIN PuRGEREEl; GO TO STARTL; END * TRY BREAK AGAIN 

ELSE p(ded;* 
GO TO exit;* 
LCLOSEIX 

IF OPTIONAL THEN * EOF ON ABSENT OPTIONAL FILE 

BEGIN FlBtS] *■ C*P(DUP))«4 C39I42J63; * MARK CLOSED RLSD 

P(xm;* 

end;* 

IF NOT SORTFlLE AND CLOSED THEN BEGIN IQERR ( 12»F I6[ 5] f £ 43 $ 1 ] ); 

go to exit; end; 
if infile then* 

if (c0b68 and mabuse and disk) then * end input/io file 

BEGIN FU1*2; PU2*-1J TEST*!* PUl«-l+4xFILIQ; * 

USERS68;* 
END ELSE* 
ELSE IF (LABELED AND NOT SORTFlLE) THEN* 



02620000 


T 


0413*0 


02620010 


T 


041510 


02620015 


T 


0415*1 


02620020 


T 


0415*3 


02620030 


T 


0416*3 


02620040 


T 


0417*1 


02620050 


T 


0420*3 


02*20060 


T 


0423*1 


02620065 


T 


042311 


02620070 


T 


042413 


02620075 


T 


0427*1 


02620080 


T 


0429*1 


02620085 


T 


0432*2 


02620090 


T 


0433*0 


02620100 


T 


0433*0 


02620200 


T 


0434*? 


02620250 


T 


0435*6 


02620300 


T 


0436*0 


02620350 


T 


0437*3 


02620400 


T 


0442JQ 


02620500 


T 


0443*0 


02620600 


T 


0444*1 


02620800 


T 


0445*3 


02620810 


T 


0447*2 


02620900 


T 


0448*0 


02621000 


T 


0451*0 


02621100 


T 


0454*0 


02621200 


T 


0456*0 


02621220 


T 


0456*0 


02621230 


T 


0456*2 


02621250 


T 


0457*0 


02621300 


T 


0459*3 


02621310 


T 


0460*0 


02621320 


T 


0460*2 


02621325 


T 


0466*1 


02621330 


T 


0472*0 


02621335 


T 


0474*2 


02621340 


T 


0474*2 


02621350 


T 


0474*2 


02621360 


T 


0478*3 


02621364 


T 


0478*3 


02621365 


T 


0485*3 


02621370 


T 


0490*0 


02621371 


T 


0490*3 


02621375 


T 


0491 S l 


02621380 


T 


049U1 


02621400 


T 


0493*0 


02621500 


T 


0496*0 


02621600 


T 


0496*1 


02621700 


T 


0496*1 


02621750 


T 


0503*2 


02621800 


T 


0504*0 


02621810 


T 


0505*0 


02621820 


T 


0508*3 


02621830 


T 


0514*1 


02621840 


T 


0515*0 


02621900 


T 


0515*0 



ft 
ft 



ft 



• 



• 



• 






IF DISK THEN* 

BEGIN % MOVE RECORD COUNT FROM HEADER TO LABEL 

STREAM <A*P([HEADERPTR]#LOD, 7* C0CM# + ), 

8«- 5 INX LBLPTR>;% 
BEGIN SI*LOC AJ DI*DI*5I DS*7 DEC; END** 
IF MABUSE OR NOT C0B68 THENX END OUTPUT FILE 
BEGIN FUU2; TEST*1J PU2*FU2*»l; 

IF C0B68 THEN BEGIN PU1*3; USERS68; END 
ELSE BEGIN PU1*6; USERS; END;x 
END/% 

end % not disk 
else begin % move 8lk & record counts from fib to lbl 
if hash then callhaSh(d;% 
streamca«-bcount,b*rcqunt#c«.5 inx l8lptr);x 

begin si*loc a; ds*5 dec; os*7 dec; end;x 
lbl «- lblptr;x 

LBLC43.EQRF* REeL*o;X 

lbl * o; xfile close forgets labels-so clear ptr 
if reel then closelock «- locku 
if mabuse or not c0b68 thenx end output file/rl 
begin fu1*2; test «■ reel=0; pu2 * 7$ 

if c0b68 then begin pui*3; users68; end 
else begin pui<-6; fu2*3; users; end; 
end;x 
end; x of nondisk 

IF DISK AND LABELED AND NOT SORTFILE THENX 
BEGlNX 

LSUBL «• *P(DUP) + i;« 

IF BOUNDED THEN % IF UPPER BOUND 

BEGIN LSUBU «■ *PCDU'P)*1* BOlNDED*FALSE* END 
ELSE IF C0868 THEN LSUBU ♦ 0; 
LBL «■ *[HEADERPtR3^% 

hnmszrs *--(c(segsper0wxrecsperblk3 div segspblk) 
& hnmrqws [20s43*5j);x nm,sz rqws fr header 
nmszrows «• 0; % zero fib nm,sz rows 
if not c0b68 then if random then w0r0sl£ft*0; 
eno;x 
if unitype'mt amd not reel thenx 

BEGIN* 

if closelock=rewlnd and notfirstreel thenx 
closelock «. lock;x 

notfirstreel <- falser 
end;x 

t *■ currentreel;x 

if reel and unitype = pbt then fibc93 ,t u 13 * 1; 

cobolclose;x 

if hnmszrs, [1j13 then 

BEGINX 

nmszrows «■ abs(hnmszrs);x 

hnmszrs * 0;x 

writback «■ false-; x random output and 1-0 
end;x 
if reel thenx 

begin x reel switch 

REEL *■ T + i;« 

CODE * 3-(2xlNFTL£)+DIRECTI0N;X 

IF CODE'QPENOUT THEN CURRENTREEL * REEL;X 



02622000 T 
02622010 T 

02622020 T 
02S22030 T 
02622040 T 
02622050 T 
02622070 T 
02622100 T 
02622200 T 
02622300 T 
02622400 T 
02622500 T 
02622600 T 
02622700 T 
02622800 T 
02622900 T 
02623000 T 
02623100 T 
02623200 T 
02623300 T 
02623400 T 
02623500 T 
02623600 T 
02623610 T 
02623620 T 
02623700 T 
02623800 T 
02623900 T 
02624000 T 
02624100 T 
02624200 t 
02624300 T 
02624400 T 
02624500 T 
02624600 T 
02624610 T 
02624700 T 
02624800 T 
02624900 T 
02624910 T 
02624920 T 
02625000 T 
02625100 T 
02625105 T 
02625110 T 
02625200 T 
02625210 T 
02625220 T 
02625225 t 
02625230 T 
02625240 J 
02625250 T 
02625255 T 
02*25260 T 
02625265 T 
02625268 T 
02625270 T 



0520*0 
0522*0 

0522*2 
0524*2 
0526U 
0527«1 
0529*0 
053212 
0535*0 

0537*0 

0537*0 

0537*0 

0537*2 

0540*3 

0543*3 

0544*3 

0546* 1 

0549*1 

0550*0 

055i*2 

0553*1 

0556*2 

0559*0 

0562*0 

0562*0 

0562*0 

0567*3 

0568*1 

0570*1 

0571*1 

0576*1 

0578*3 

0580*0 

0582*0 

0585*0 

0587*2 

0591* l 

059i*l 

0593*2 

0594*0 

0596*0 

0597*1 

0599*3 

0599*3 

0601*1 

0606*1 
0609*1 
0610*0 
0610*2 
0613*1 
0614*0 
0616*2 
0616*2 
0616*3 
0617*1 
0618*2 
0622*1 



0' 



IF N 
% 



• 



LINVA 
LCLOS 



LID« 

TERM 
El:* 
IF M 
IF E 
FOR 



ELSE 
OT SVF 
IF CO 

THROW 



PCVIT 

* 

(25);% 



END* 
CURR 
IB T 
B68 

AWA 

P(FL 

[8 

)i 



NOTFIRSTREEL * TRUE* 
GO TO STARTUX 

ENTREEL * 01 

HEN 

AND CL0SEL0CK>1 THEN IF CT*F IBC203 ) <0 THEN 

Y FILE TANK* RE-I NITI ALI ZE TYPE"*2 SEGMENT DESC 

OC#DUP>FCX,3,COM,FLAG(0 & T [23:8*103 & T 

:e: 10 3 & 9 C3*44;43)*SSN,XCH#*>; 



I 
BSTpt* 



OTINANDOPEN THEN TERM ( 1 2~F I B [ 5 3 . C 43 5 U ) ; * 
NDFILE THEN BEGIN I * 1; 60 TO BSTPf ENDU 
I «• 1 STEP 1 UNTIL NuMBUFF DO* 
BEGIN * WAIT UNTIL ALL IO-S ARE DONE* 
IF NOT IODONE THEN WAlTlO;* 

if flocci+23.eof then go bstp;* 
end;* 
numbuff;* 



BACKSPAC 

TIP. EOF 
CLOSEDHE 
FIBC53.C 
GO TO EX 
L0PEN15* 

IF FIBC5 
FIBC53.C 
BUFTOP * 
INFILE «■ 
LBLPTR «• 
IF TIP.E 
BEG 



END 
ELSE BEG 



e; * backspace i blocks 
«- endfile;* 

RE * C0B68;* 

40J6] «- closedret;* 

IT/* 



END 
FOR T «■ 

FLO 
GO TO EX 
LSORTS* 

IOD * [T 
IF CLOSE 

BEG 



],U0I6J/CL 

40:6] ♦• o;* 
(*P(OUP) )& 
0* * MAKE 
(*PCDUP))& 
OF THEN* 

IN * HAD 
WORDSLEFT 
TIP. EOF «■ 
COUNT «■ N 
BUFTOP f CC 

* 

IN * NO EOF 
RCOUNT * 
BCOUNT * 
WORDSLEFT 
COUNT «• W 

;* 

1 STEP 1 UN 
CCT+23 «■ FL 

it;* 



osedret then termc6);* 

resetreadbit;* 
it output 
resetreadbit;* 

read eof before backspace 
* buffersize;* 
o; * reset eof 
umrec; * # recs left in buff * 

F3 <• TIP f [CF3;% 



WHOLE BUFF 



- OPEN IN PLACE 
*PCDUP)-i;* BACK UP BECAUSE WE 

+PCDUP)-i;* WERE READING 

* BUFFERS I ZE-CT IP, CCF3-BUFTOP.ECF3);* 
ORDSLEFT DIv MAXREC; % * RECS LEFT IN BUFF 

TIL NuMBUFF DO* 

AGCBUFTOP&FLOCIT+23CCTC3); * CHANGE TO WRITE 



IP];* 

LOCK=NOREW THEN 
IN 

IF NOT (*IOD).EOF 

THEN TERMC19) 
ELSE 

BEGIN ALGOLIO(ll);* READLABEL 



* FCR CALLED WITH THESE PARAMS 
*IF 10 COMPLETE BUT NOT PRESENT 

* NOT EOFtMUST HAVE BEEN PARITY 

* TERMINATE ON PARITY 

* MUST HAVE BEEN EOF OR EOR 



02625280 T 
02625300 T 
02625400 T 
02625500 T 
02625510 C 
02625600 T 
02625650 T 
02625700 T 
02625800 T 
02625950 T 
02626000 T 
02626050 T 
02626100 T 
02626150 T 
02626200 T 
02626250 T 
02626300 T 
02626350 T 
02626400 T 
02626450 T 
02626500 T 

02626550 T 
02626600 T 
02626650 T 
02626660 T 
02626700 T 
02626750 T 
02626800 T 
02626850 T 
02626900 T 
02626950 T 
02627000 T 
02627050 T 
02627100 T 

02627150 T 
02627200 T 
02627250 T 
02627300 T 
02627340 T 
02627350 T 
02627400 T 
02627450 T 
02627500 T 
02627510 T 
02627600 T 
02627650 T 
02627700 T 
02627750 T 
02627800 T 
02627850 T 
02627860 T 
02627870 T 
02627880 T 
02627890 T 
02627900 T 
02627910 T 
02627920 T 



0626*0 
0628*2 
0629*0 
0629»0 
0632*0 
0632*2 
0636*1 
0636*1 

0639*1 
0642U 

0642*2 
0642*2 
0644*1 
0644*1 
0649*2 
0652*1 
0656*3 
0656*3 
0662*0 
0664*3 
0667*0 
0668*2 
0668*2 
0671*0 

0674*2 
0677*0 
0679*2 
0680*0 
0680*0 
0683*1 
0685*3 
0688*1 
0690*3 
0693*2 
0695*0 
0695*2 
0697*2 
0700*1 
070i*3 
0705*0 
0705*0 
0705*2 
0707*2 
0709*2 
0714*2 
07171 1 
0717*1 
0721*3 
0726*2 
0727*0 
0727*0 
0728*1 
0729*0 
0729*2 
0730*2 
0732*2 
0732*2 



• 



.*. • 



end;% 



LBL *■ LBLPTRJ% 

IF LBLU3.E0RFB0 THEN PC 1 »RTN ) URETURN EOF 
REEL «■ CURRENTREEL + 1UREEL SWITCH ON INPUT 
T «■ COBOLFlLBIT; % REMEMBER IF COBOL FILE 
FCRCLOSE(PURGE); 

FlBtl3]*(*PCDUP))«REELC28l3e»l0l% NxT REEL 
&0 [47*47*1]; % MAKE IT LOOK ALGOL 
ALGOLlO(0);X OPEN INPUT NEXT REEL 
FIBC133 «-C*P(DUP))OR Tf% RESTORE COBOL SIT 
P(Q,RTN); % RETURN EOR 



• 

• 



FXlTJ i% 

END 



END NOREw;% 
IF CLOSELQCKsREW 

BEGIN % 
LBL «■ 
LBLC4] 

LBL * 
T «- CU 
FCRCLO 
CURREN 
IF COB 
P(XIT) 

end;% 

IF CLOSELOCKsLQC 
BEGIN* 

1 «- IF 

FCRCLO 
P(XIT) 

end;* 
cobolfcrjx 



IND THENX 

REEL SWITCH ON OUTPUT 
LBLPTRT* 

,EORF * 1J % EOR 

0;XFILE CLOSE pOGETS LABEL SO PTR MUST BE CLRD 
RRENTREEL+li* 

SECRELEASE); % CLOSE RELEASE CURRENT REEL 
TREEL «• REEL <• T;*WITH NO REEL SWITCH-DONE HERE 
OLFILE THEN FCROPENOUT ELSE ALGOLlQC > J %NXT RL 
i % OPEN OUT (ALGOL OR COBOLJNXT REEL 



K THEN 

CURRENTREEL=1 THEN 
SE(T); % CLOSE 
i % CLOSE 



REWIND ELSE RELEASE; 
REWIND FIRST REEL* 
RELEASE ALL OTHERS 



02627930 
02627940 
02627950 
02627960 
02627970 
02628000 
02628050 
02628100 
02628150 
02628200 
02628250 
02628300 
02628310 
02628320 
02628330 
02628340 
02628350 
02628360 
02628370 
02628380 
02628390 
02628400 
02628450 
02628500 
02628510 
02628520 
02628550 
02628600 
02628700 
02628800 
02628900 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



073452 
0736»0 

0738*2 

0740*2 
0742»0 
0743»2 

0744*3 
0747*0 
0748*2 
0750*2 
0751*0 
075i*0 
075110 
075113 
0752*1 
0753*3 
0756*1 
0757*0 
0759*0 

0760*2 
0763*2 
0767*3 
0768*0 
0768*0 
0768*3 
0769*1 
0772*3 
0774*1 
0774*2 
0774:2 
0775*0 



SIZE 55 0776 WORDS 



PROCEDURE CfjBOLATT* 



BEGIN 



% INT # * 165 






COMMENT INTRINSIC FOR COBOL ATTRIBUTES 
CALLING SEQUENCE IS 
MKS 

LITC OPERATION 
LITC FILEFIB 
DESC 10 

LITC ATTRIBUTENUM 
LITC WOPD-OFSET 
DESC DATAWGRD 

OPERATIONS ARE* 
1 a MOVE 
= SET (OR CHANGE ATTRIBUTE VALUE) 

ATTRIBUTENUM HAS THE FOLLOWING VALUES} 

* EOF 

1 = DO NOT USE 

2 ~ DO NOT USE 

3 s SAVEFACTOR 



%CJC 


1031 


02650000 


T 


0000*0 


START 


OF REL 


SEGMENT; DISK 


ADDRESS = 


%CJC 


1031 


02650100 


T 


0000*0 


XCJC 


1031 


02650110 


T 


0000*0 


%CJC 


1031 


02650120 


T 


0000*0 


ICJC 


1031 


02650130 


T 


0000*0 


%CJC 


1031 


02650140 


T 


0000*0 


XCJC 


1031 


02650145 


T 


0000*0 


ascjc 


1031 


02650150 


T 


0000*0 


*CjC 


1031 


02^50160 


T 


0000*0 


%CJC 


1031 


02650170 


T 


0000*0 


*ejc 


1031 


02650180 


T 


0000*0 


XCJC 


1031 


02650190 


T 


OOOO'O 


XCJC 


1031 


02650200 


T 


0000*0 


%CJC 


1031 


02650210 


T 


0000*0 


*CJC 


1031 


02650220 


T 


0000*0 


3CJC 


1031 


02650230 


T 


0000*0 


XCJC 


1031 


02650240 


T 


0000*0 


%CJC 


1031 


02650250 


T 


0000*0 


%CJC 


1031 


02650260 


T 


0000*0 


%CJC 


1031 


02650270 


T 


0000*0 



00253 



• 



• 



• 



END-OF 

NAME 
REAL 
NAMf 
REAL 



ARRAY 

ARRAY 
ARRAY 
LABEL 



4 B AREAS 

5 = AREASIZE 

6 ■* ^FIO 

7 «* FIO 

8 - REEL 

9 = DATE 

10 = BUFFERS 

11 = TYPE 

12 = 8L0CKSIZE 

13 = MAXRECSIZE 

14 ~ FILE INFORMATION BLOCK 

15 = FILE PARAMETER BLOCK 

16 ■ LABEL (8 WORDS ONLY) 

17 = EU NUMBER (0 THRU 19) 

IB = DISK SPEED ( 1=FAST* 2-SLOW ) 
19 = TIMELlMlf (PROTECT FIlES) 

20 - iostatus (protect files) 

21 = sensitive 
•comments; 



SWITCH 



REAL 
DEFINE 



ITEM 
ATTNUM 
FLOC 
OPCODE 

FPB 

F I B [ * 3 ; 
LBLC*3* 



» "i; * COMp AREA FOR VALUE 

= ~2J % ATTRIBUTE NUMBER 

- -3; % POINTER TO FIB 

' -4) % OPERATION OsSET 1»MQVE 

* 3C*]I % FILE PARAMETER BLOCK 



e0f,i0err* savefactor*areas* 
are as i ze * mf 1 d* f 10* reel * date* buffers, 
type* blocks izf* maxrecsize* at tex it* 

fibwords*fpbwords*labelwords* 

eunum,dskspeed# 

timelimit*iostatus* 
sensitive* 

dummy; 

•• eof*ioerr*ioerr *savefactor* areas* 
areas ize*mf id, fid* reel* date* buffers* 

type* blocks ize' maxrecsize* 
f i bw0rds*fpb words* label words* 
eunum,dskspeed* 
timelimit*iostatus* 

sensitive* 
ioerr; 



xi*temp*unitype; 

GETFROMITEM a P<*dTEM3)#, 
STOREINTOITEM(STOREINTOITEMI) m 

P( STORE INTO I TEM1*[ITEM3**)#* 
IOERROR(IOERRORI) = 

P(l*FL0C*IOERR0Rl*l7,COM)#; 



ROUTINE 



3CJC 


1031 


SCJC 


1031 


%CJC 


1031 


SCJC 


1031 


%C4C 


1031 


XCJC 


1031 


*CJC 


1031 


XCJC 


1031 


*CJC 


1031 


%CJC 


1031 


*CJC 


103J 


*CJC 


1031 


%CJC 


1031 



*CJC 
*CJC 
SCJC 
SCJC 
XCJC 
»CJC 
%CJC 
SCJC 
SCJC 
%CJC 
3SCJC 
XCJC 
*CJC 
%CJC 



1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 



%CJC 1031 
%CJC 1031 
*CJC 1031 



COMMENT 



I/O ERRORS ARE AS FOLLOWS: 
no = FILE WAS OPEN WHEN SETTING THE 
41 = SETTING A READ ONLY ATTRIBUTE 



ATTRIBUTE 



*CJC 
%CJC 
XCJC 
%CJC 
8CJC 
SCJC 
UCJO 
%CJC 
8CJC 
SCJC 
58CJC 



1031 
1031 
1031 
1031 
1031 

1031 
1031 
1031 
1031 
1031 
1031 



02650280 


T 


0000*0 


02650290 


T 


0000*0 


02650300 


T 


0000*0 


02650310 


T 


0000*0 


02650320 


T 


0000*0 


02650330 


T 


0000*0 


02650340 


T 


0000*0 


02650350 


T 


0000*0 


02650360 


T 


0000*0 


02650370 


T 


0000*0 


02650371 


T 


0000*0 


02650372 


T 


0000*0 


02650373 


T 


0000*0 


02650374 


T 


0000*0 


02650375 


T 


0000*0 


02650376 


T 


0000*0 


02650377 


T 


0000*0 


02650378 


T 


0000*0 


02650380 


T 


0000*0 


02650390 


T 


0000*0 


02650400 


T 


0000*0 


02650500 


T 


0000*0 


02650600 


T 


0000*0 


02650700 


T 


0000*0 


02650800 


T 


0000*0 


02650900 


T 


0000*0 


02651000 


T 


0000*0 


02651100 


T 


0000*0 


02651110 


T 


0000*0 


02651300 


T 


0000*0 


02651400 


T 


0000*0 


02651410 


T 


0000*0 


02651500 


T 


0000*0 


02651510 


T 


0000*0 


02651520 


T 


0000*0 


02651530 


T 


0000*0 


02651590 


T 


0000*0 


02651595 


T 


0000*0 


02651600 


T 


0000*0 


02651610 


T 


0000*0 


02651700 


T 


0000*0 


02651710 


T 


0000*0 


02651720 


T 


0000*0 


02651730 


T 


0000*0 


02651740 


T 


0000*0 


02651799 


T 


oooo'o 


02651800 


T 


0000*0 


02651900 


T 


0000*0 


02652000 


T 


0000*0 


02652100 


T 


0000*0 


02652150 


T 


0000*0 


02652200 


T 


0000*0 


02652250 


T 


0000*0 


02652251 


T 


0000*0 


02652252 


T 


0000*0 


02652253 


T 


0000*0 


02652254 


T 


0000*0 



m 



# 

# 



END OF 
START 



42 
43 
44 

45 
46 

47 
48 
49 
I/O 



SETTING AN ATTRIBUTE TO AN 

CHANGING # OF BUFFERS OF A 
= INCREASING * OF BUFFERS 
» CHANGING BLOCKSIZE TO A VALUE WHICH IS NOT 

A MULTIPLE OF RECORD SIZE 
- CHANGE TO BLOCKSIZE WHEN FILE IS 

TAPE* PAPER TAPE OR S E RIAL DISK 
* ACCESSING "LABEL" WHEN FILE IS NOT OPEN 
= THIS FILE MAY NOT HAVE "TYPE" CHANGED 
a ILLEGAL ATTNUM VALUE 
ERRORS; 



ILLEGAL VALUE 
NON*SERIAL FILE 



OTHER THAN 



IOERR 
EOF: i 



t t 



HERE 
FIB <- *FLOC; 

IF FIBC53.U1J2J * THEN 
NOT FIBU3. [12*13 THEN 
C(FIB[43, [12*123 -U 
♦ FIBC43. [1311131 

QPCQOE » AND F IBt 5 3 , [41 j 2 3 • THEN 
IOERRORUG); % SET AN ATTRIBUTE ON 
% WHICH IS OPEN. 
GO TO ROUTINECATTNUM3; 
I0ERRQRC49); % ILLEGAL ATTNUM 



IF 

XI 
IF 



LBL «• FLOCtHi 

FIB£4], [12*123 * 

x ETRLNG) & IC36I47I1 



A FILE 



IF OPCODE = THEN I0ERR0RC41)/ 

% EOF IS READ 
STGREINT0ITEMCFIB[53. [40513); 
GO TQ ATTEXIT; 



ONLY 



AREAS?: 



• 
• 



AREASIZEl 5 



IF OPCODE - THEN 

IF (TEMP «- GETFROMITEM) < 1 OR TEMP > 20 THEN 

I0ERR0RC42) ELSE % OK VALUES 1-20 

FIBC83, [20153 «• TEMP ELSE 
STORE INTO ITEM (FIB [8]. [20:53); 
GO TO ATTEXITJ 



IF OPCODE - THEN 

IF (TEMP *■ GETFROMITEM) < 1 THEN 

I0 F _RR0R(42) ELSE % MUST HAVE 1 OR MQR E 

FIB[8], [25:23.3 «- TEMP ELSE 
STORElNTOlTEM(FIB[83.[25J233 3i 

GO TO attexit; 



MFID 
FID: : 
IF 



: 



XCJC 
*CJC 
SCJC 
%CJC 
SCJC 
SCJC 
XCJC 
XCJC 
SCJC 
%CJC 
XCJC 
*CJC 
XCJC 
%CJC 
iCJC 

ICJC 

3UCJC 

%cuc 

SSCJC 
%CJC 
%CJC 
XCJC 
%CJC 
%CJC 
XCJC 
%CjC 

icjc 

%CJC 
*CJC 

xcgc 

*CJC 
%CJC 

icac 

SSCJC 
*CJC 
3SCJC 
XCJC 
%CJC 
XCjC 
*CJC 
3CJC 
%CJC 
SKCJC 
%CJC 
%CJC 
XCgC 
*CJC 
XCjC 



1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
103J 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 

1031 
1031 
1031 
1031 
1031 
1031 
1031 

1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 



OPCODE a AND FIB [53. [42*1] s THEN 

IF <(UNlTYPE«-FP8[XI + 33, [43:53)* 10 OR UNITYPE ■ 12 

OR UNITYPE * 13) THEN % DISK FILE IS NOT CLOSED WITH RELEASE 
I0ERR0RC40); % CANT CHANGE MFID/FID 

ATTNUM * ATTNUM - 6j XCJC 1031 

IF FIBC43.C2H3 > THEN % IF LABELED XC*IC 1031 

IF OPCODE ~ 1 AND F IB [53 , [41 S 33 ■ 1 THEN ICJC 1031 

BEGIN % IF "MOVE" AND FILE OPEN INPUT PICKUP SCJC 1031 

% MFID AND ID FROM LABEL IN CASE OF "IL", %CjC 1031 



02652255 
02652256 
02652257 
02652258 
02652259 

02652260 
02652261 
02652262 
02652263 
02652264 
02652290 
02652300 
02652400 
02652500 
02652550 
02652600 
02652700 
02652800 
02652900 
02653000 
02653100 
02653200 
02653250 
02653300 
02653400 
02653500 
02653600 
02653700 
02653800 
02655500 
02655600 
02655700 
02655800 
02655900 
02656000 
02656100 
02656200 
02656300 
02656400 
02656500 
02656600 
02656700 
02656800 
02656900 
02657000 

02657100 
02657200 
02657300 
02657310 
02657320 
02657330 
02657340 
02657400 
02657405 

02657410 
02657420 
02657430 



T 
T 
T 

T 
T 

T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

C 

c 
c 
c 

T 
T 
T 
T 
T 



0000«0 
0000*0 

0000 so 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000 '0 

ooooso 

0000*0 

0000*0 
0000*0 
0000*0 

0002*1 

0Q05*3 
0008*2 
0012«3 
0014*1 
0016*3 
0018*2 
0018*2 

003i:o 

0032*1 
0032*1 
0033*0 
0035*2 
0035*2 
0037*0 
0037*2 

0037*2 
0038*0 
0038*3 
004ii3 

004382 
0046*2 
0048*2 
0049*0 
0049*0 
0049*0 
0049*3 
005l*3 
0053*2 
0056*2 
0058*2 
0059*0 
0059*0 
0059*0 
0059*0 
006H2 
0064*3 
0066*2 
0068*1 
0069*2 
0071J0 
0074*0 
0074*2 



• 





STOREINTOITEMCLBLCATTNUM + l] f [6»423)J XCJC 1031 02657440 T 0074?2 

GO TO ATTEXIT; XCJC 1031 02657450 J 0077*1 

W ENd; *C JC 1031 02657460 T 0077*3 

IF OPCODE = THEN XCJC 103J 02657500 T 0077*3 

FP8CX1 + ATTNUM3. [6:423 «■ GETFROMITEM ELSE XCJC 1031 02657600 T 0078*2 

"J ST0REINTQITEMCFP8CXI + ATTNUM] . [ 6 8 42] ); XCJC i03l 02657700 y OO82H* 

GO TO ATTEXIT; SCJC 1031 02657800 T 0085*2 

X MOTE THAT MFIO MUST BE ATTRIBUTE 6 AND FID MUST XCJC 1031 02657900 T 0086*0 

• X BE ATTRIBUTE 7 TO MAKE THE ABOVE WORK, XCjC 1031 02658000 T 0086*0 

*CJC i03 I 02658100 T 0086*0 

m BUFFERS.? %C4C X03l 02658200 T 0086*0 

W I F OPCODE = THEN XCJC 1031 02658300 T 0086*0 

IF FIBC43.C2783] t THEN I0ERR0RC43) ELSE XCJC 1031 02658400 T 0086*3 

% CHANGING t OF BUFFERS ON NON-SERIAL XCJC 1031 02658500 T 0090*2 

IF < T( ^P * GETFROMITEM) > FIBC 1 33 . [ 1 » 9 3 THEN XCJC 1031 02658600 T 0090*2 

I0ERR0R(44) ELSE X INCREASING f OF BUFFERS XCJC 1031 02658700 T 0093*1 

m IF TEMP < 1 THEN I0ERRORU2) ELSE XCJC 1031 02658800 T 0095*0 

w FIBC133. C1I93 * TEMP ELSE XCjC 1031 02658900 T 009 S ;0 



# 



STOREINTOITEM(FIBCl33.tl*93); XCJC 1031 02659000 T 010i*0 

GO TO ATTEXIT; XCJC 1031 02659100 T 0103*0 

02659200 T 0103*2 • 

BLOCKSIZEJS XCJC 1031 02659300 T 0103*2 

T T £™£? D L^ l THEH r « %CJC 103 * 02659400 T 0104*0 

BEGIN STQRElNT0ITEMCFI8tl83,t3il5]); XCJC 1031 02659500 y 0104*3 • 

GO TO ATTEXIT; XCJC 1031 02659600 T 0106*3 

END; XCJC 1031 02659700 T Ol07*l 

X THE FOLLOWING WILL "SET" BLOCKSIZE* XCJC 1031 02659800 T 0107*1 # 

IF (TEMP «- GETFROMITEM) MOD FIBC 18 3 . 1 33 * 15 ] t XCJC 1031 02659900 T 0107*1 

THEN I0ERR0RC45)* ICjC 1031 02660000 T 0109*3 

% I/O ERROR 45 IF NOT MULTIPLE OF RfCORD LENGTH XCJC 1031 02660100 T 0111*3 

IF NOT (CUNITYPE ♦ FPBUI + 33, [4315]) • 2 XCJC 1031 02660200 T 0111*3 

OR UNITYPE * 7 OR UNITYPE * 8 XCJC 1031 02660300 T 01U»0 

OR UNITYPE - 9 OR UNITYPE * 12) THEN XCJC 1031 02660400 T 0115*3 

I0eRR0R(46>; XCJC 1031 02660500 T 0118*2 

I/O ERROR 46 UNLESS FILETYPE IS MaGTAPE* PAPERTAPE XCJC 1031 02660600 T 0120*1 

OR SERIAL DISK, %CJC 103I 02660700 T 0120*1 

% AT THIS POINT THE CHANGE TO BLOCKSIZE IS VALID XCJC 1031 02660800 T 0120*1 

X A CHANGE TO TECHNIQUE ( F I B C 5 3 , U6 J 23 ) AND RECORDS %CJC 1031 02660900 T 0120*1 

% PER BLOCK CFIBClll) IS TAKEN INTO CONSIDERATION. XCJC 1031 02661000 T 0120*1 

FIBC183.C3S153 * TEMP; XCJC 1031 02661050 T 0120*1 

FIBC 113 <• TEMP DIV FIBC 18] , [331 15 JJ XCJC 1031 02661100 T 0122*3 

FIBC53.C46S2] «. (if FIBCH3 » 1 THEN ELSE 1); XCJC 1031 02661200 T 0125*1 

GO TO ATTEXITJ XCJC 1031 02661300 T 0130*0 

XCJC 1031 02661400 T 0130*2 

MAXRECSiZEM n0 „ nne n , 11Fl , n oa „ % ^CJC 1031 02661500 T 0130*2 

IF OPCODE » THEN I0£RR0R(4l)J XCJC 1031 02661600 T Ol3l»0 

X MAXRECSIZE IS READ ONLY XCJC 1031 02661700 J 0133*2 

STGREINT0ITEM{FIBC183. [331153)1 XCJC 1031 02661800 T 0133*2 

GO TO ATTEXIT; XCJC 1031 02661850 T 0135*0 

TVO _ *CJC 1031 02661900 T 0135*2 

TYPE * $ ,„ .„,„„ „ *CJC 1031 02661990 T 0135*2 

IF OPCODE = 1 THEN XCJC 1031 02662000 T 0136*0 

BEGIN STOREINTDITEMCFPBCXI + 3], [43*53); XCJC 103J 02662010 T 0l36*3 

GO TO ATTEXIT; XCJC 1031 02662020 T 0139*1 

end; ., 02662030 T 0139*3 

IF (TEMP «- FPBCXI + 33. [43*53) > 9 AND TEMP < 15 02662040 T 0139*3 

OR TEMP * 19 OR TEMP a 26 02662050 T 0142*2 



XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


xcjc 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


ICJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


xcjc 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 


XCJC 


1031 



• 



• , 



THEN IQERRQRU8); 
I/O ERROR 48 = FILE TYPE NOT ALTERABLE 

FPBCXI + 3], [43*5] «• TEMP * GETFROMITEMJ 

IF TEMP s % CA R D 

OR TEMP > 19 AND TEMP < 26 THEN SPUNCH BACKUP 

IF FIB[183. [3:153 < 11 THEN GO TO ATTEXIT 

ELSE I0ERRORC42); % AND BLOCK < \\ WORDS 

IF TEMP a 1 OR TEMP ■ 4 OR TEMP m 6 

OR TEMP > 14 AND TEMP < 19 THEN % PRINTERS 

IF FIB[183. [3:151 < 18 THfN GO TO ATTEXIT 

% BLOCK < 18 WORDS 

% MAG TAPE 

% PAPER TAPE 

% PT UNLABELED 

% MT UNLABELED 



ELSE I0ERRORC4P)* 
IF TEMP = 2 

TEMP « 7 

TEMP = 8 

TEMP * 9 THEN 

TO ATTEXIT; 



OR 

OR 
OR 
GO 



I0ERRUR(42)i 



SAVEFACTOR 



reels* date*: 

if opcode = then 
begin streamck+ctemp], 
begin si * l; di *■ kj 
end; 

if attnum = 9 then % "date" 

FPBCXI + 23 • CIS 1303 * TEMp 
IF ATTNUM = 8 THEN % "REEL" 
FPBtXI + 23, C1H73 * TEMP 
FIB[43.C30S183 «• TEMP; 
GO TO ATTEXIT; 



% "SET" ATTRIBUTE 
L*CITEM3); 

ds * a dec; 



ELSE 

ELSE 



END; 



IF FIBU1.C2U3 * 1 THEN l0ERR0R(47); 

STREAM(K «- IF FI8C53. [^1523 i THEN 
IF ATTNUM * 9 THEN FPB [ X I +23 , U8 S 30 3 ELSE 
IF ATTNUM = 8 THEN FPBC Xl + 2 3 . [ 1 * 1 7j ELSE 
FIB[43.[30:i83 ELSE 

IF ATTNUM = 9 ThEN LBL [ 3 3 , 1 18 * 30 3 ELSE 
IF ATTNUM s 8 THEN LBL [ 3 3 . t 1 * 17 3 ELSE 
FIB[43,[30!183, L «. f JTEM3); 

begin si«-loc k; di*l; DS*8 oct; 

end; 

go to attexit; 



FIBWGRDS* 



IF OPCODE * THEN 

STREAM(A«.[FIB[033> 
BEGIN Si «■ a; DI < 

end; 

go to attexit; 



IOERRORUIW 
% FIB IS READ ONLY 
B«-[ITEm3 >' 
b; DS * 20 WDS; 



FPBWOROSl 



IF OPCODE ■ THEN IQERR0RC41); 

3! FPB IS READ ONLY 
STREAM(A«-[FPB[XI33> B*[ITeM]); 

begin si «. aj di * b; ds <• 5 wds; 

end; 

go to attexit; 







02662060 


T 


0144*2 






02662080 


T 


0147*0 


%CJC 


1031 


02662100 


T 


0147J0 


%cuc 


1031 


02662200 


T 


0150*3 


%CJC 


1031 


02662300 


T 


0151«1 


icjc 


1031 


02662400 


T 


0153*2 


*C*IC 


1031 


02662500 


T 


0155*2 


XCJC 


1031 


02662600 


T 


0157*1 


%CJC 


1031 


02662700 


T 


0159*2 


%C4C 


1031 


02662800 


T 


0162*0 


*CJC 


1031 


02662900 


T 


0164*0 


SCJC 


1031 


02663000 


T 


0165*3 


%CJC 


1031 


02663100 


T 


0166*1 


%CJC 


1031 


02663200 


T 


0167*0 


56CJC 


1031 


02663300 


T 


0168*0 


»CJC 


1031 


02663500 


T 


0169*2 


%CJC 


1031 


02663600 


T 


0170*1 


*CJC 


1031 


02663700 


T 


0171*2 


%CJC 


1031 


02663800 


T 


017152 


scuc 


1031 


02663900 


T 


0172*0 


*cjc 


1031 


02664000 


T 


0172;3 


xcuc 


1031 


02664100 


T 


0174*1 


scjc 


1031 


02664200 


T 


0175J0 


*cjc 


1031 


02664300 


T 


0175*1 


%cuc 


1031 


02664400 


T 


0176*0 


«CJC 


1031 


02664500 


T 


0179*2 


*CJC 


1031 


02664600 


T 


0180*3 


%CJC 


1031 


02664800 


T 


0184*1 


*CJC 


1031 


02664900 


T 


0187*1 


*CJC 


1031 


02665000 


T 


0187*3 


ICJC 


1031 


02665050 


T 


0187*3 


SCJC 


1031 


02665100 


T 


0l9 t ?0 


*cuc 


1031 


02665200 


T 


0192*3 


%CJC 


1031 


02665300 


T 


0196*2 


%cjc 


1031 


02665350 


T 


0199*3 


scuc 


1031 


02665360 


T 


0201*1 


*CJC 


1031 


02665370 


T 


0204*0 


*CvlC 


1031 


02665400 


T 


0206*3 


ICJC 


1031 


02665500 


T 


0208*1 


*CJC 


1031 


02665600 


T 


0209*0 


*C*IC 


1031 


02665700 


T 


0209*1 


ascjc 


1031 


02665800 


T 


0209*3 


SCJC 


1031 


02665900 


T 


0209*3 


£CJC 


1031 


02666000 


T 


0210*0 


*CUC 


103J 


02666100 


T 


0212*2 


ICJC 


1031 


02666200 


T 


0212*2 


XCJC 


1031 


02666300 


T 


0213*3 


ICJC 


1031 


02666400 


T 


0214*2 


*C*IC 


1031 


02666500 


T 


0214*3 


SIC JC 


1031 


02666600 


T 


0215*1 


*CJC 


1031 


02666700 


T 


0215*1 


%CJC 


1031 


02666800 


T 


0216*0 


%CJC 


1031 


02666900 


T 


0218*2 


%CJC 


1031 


02667000 


T 


0218*2 


XCjC 


1031 


02667100 


T 


0219*3 


*CJC 


1031 


02667200 


T 


0220*2 


ascjc 


1031 


02667300 


T 


0220*3 



n 



EUNUMJ 



DSKSPEED* * 



LABELWORDSS! %CJC 

IF OPCODE s o THEN I0ERR0RC41); SSCJC 

% LABEL IS READ ONLY %CJC 

IF FIBE53.UH2J / THEN I0eRR0R(47); %CJC 
% I/O ERROR 47 5 ACCESS TO LABEL WHEN FILE NOT OPEN %CJC 

IF FI8C4].C2H3 ■ I THEN i0ERR0R<47)J *CJC 

STREAMCa«-CLBLC033, B*[ITEM])J %CJC 

BEGIN SI «- a; DI ♦ b; OS ♦ 8 wds; %CJC 

end; %cjc 

go to attexit; %cjc 

if fi8c53 «c41 8 2 3 = and opcode'o then go to attexit* 

if opcode = then 

FP8CXl+33i£ 18153 l«6ETFR0MiTEM*l ELSE 

STORE INT0ITEM(FPB[X 1 + 33, [188 53-1) J 

GO TO ATTEXIT* 

IF FIBC53 • C41 123 *= AND QPCODEwO THEN GO TO ATTEXIT; 

IF OPCODE = THEN 

FPBCXI+33,[ 16:23 J=GETFROMlTEM ELSE 

BEGIN 

TEMP s* IF CTEMP:sFPBCXl+33.C16{23)sl THEN 
1 ELSE IF TEMP*2 THEN 2 ELSE OJ 

storeintoitemctemp); 
end; 
go to attexh; 

timelimitjj 

if opcode = then 

$ SET OMIT = NOT SHAREDISK 

ELSE 
BEGIN 

$ set omit = not sharedisk 

storeintoitemctemp); 

end; 

go to attexit; 

iostatus* * 

if opcode = then i0err0rc41); 

% iostatus is read only 
$ set omit * not sharedisk 

storeintoitemctemp); 
go to attexit; 



1031 
1031 

1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 
1031 



SENSITIVE: 



ATTEXIT: J 



IF 0PC0DE s THEN 

FP8[XI+3 3.C15J13S=GETFR0MITEM ELSE 

BEGIN 

TEMPl«FPBCXI + 3].Cl5»nj 

storeintoitemctemp); 
end; 
go attexit; 

pcxit); 

end of cobqlatt; 



02667400 


T 


0221*1 


02667500 


T 


0221*1 


02667600 


T 


022210 


02667700 


T 


0224*2 


02667710 


T 


0224*2 


02667720 


T 


0227*3 


02667730 


T 


0227*3 


02667800 


T 


0231*0 


02667900 


T 


0232*1 


02668000 


T 


0233*0 


02668100 


T 


0233*1 


02668200 


T 


0233*3 


0266830Q 


T 


0237*1 


02668400 


T 


0238*0 


02668500 


T 


0242*1 


02668600 


T 


0245*1 


02668700 


T 


0245*3 


02668800 


T 


0249*1 


02668900 


T 


0250*0 


02669000 


T 


0253*3 


02669100 


T 


0254*1 


02669200 


T 


0256*3 


02669400 


T 


0260*3 


02669500 


T 


0261*2 


02169600 


T 


0261*2 


02680000 


T 


0262*0 


02680100 


T 


0262*0 


02680200 


T 


0262*0 


02680299 


T 


0262*3 


02680500 


T 


0262*3 


02680600 


T 


0263*1 


02680699 


T 


0263*3 


02680900 


T 


0263*3 


02681000 


T 


0264*2 


02681100 


T 


0264*2 


02681200 


T 


0265*0 


02681300 


T 


0265*0 


02681400 


T 


0265*0 


02681500 


T 


0267*2 


02681599 


T 


0267*2 


02681800 


T 


0267*2 


02681900 


T 


0268*1 


02682000 


T 


0268*3 


02683000 


T 


0268*3 


02683100 


T 


0268*3 


02683200 


T 


0269*3 


02683300 


T 


0273*2 


02683400 


T 


0274*0 


02683500 


T 


0276*0 


02683600 


T 


027 6 *3 


02683700 


T 


0276*3 


02685000 


T 


0277*1 


02686000 


T 


0277*1 


02687000 


T 


0278*1 


SIZE* 0279 



WORDS 



» if M. 



* * 



PROCEDURE COBOLOCJ 



% INTRINSIC NUMBER 167 



START OF REL 



BEGIN 
REAL 
NAME 
REAL 



• 
• 



^INTEGER 



CODE 

DLOC 

NUMWDS 

KEY 

EXPSTATAR 

CHNNL 

LINES 

TIMEOUT 

SKIPAFT 

STATN 
TUNR 



'i; 

•2; 

•3* 
•4* 

•4# 
'4* 
'5* 
•5* 
>6 

'6* 
•71 



% 0*R E AD*l s WRITE*2-SEEK,6sWRT8LK# 

% POINTS TO BUFFER I/O OESC 

* # WdS TO BE WRITTEN 

% RANDOM RECORD ADDRESS OR CARRAGE RTN 

% AREA TO EXPAND STATUS INTO 

% LP CHANNEL SKIP 

% # LINES TO BE SPACED 

% UNTIL PORTION OF DATA COM 

% 1»SPACE AFTER PRINT 

% DATA COMM STATION (BUFFER) 

% DATA COMM TERMINAL UNJT 



^LOCALS 



• 



DEFINE 



REAL 
REAL 
REAL 
ARRAY 

REAL 

NAME 

ARRAY 

ARRAY 

NAME 

ARRAY 

REAL 

REAL 

REAL 

REAL 

REAL 

REAL 

INTEGE 

INTEGE 

ARROW 



C0BOLC0NTR0L=23; 
COBQLINDEX = 22; 
DEST J 
FIB [*]; 
FILECTRL =12 i 

flqc; 

FPB = 3[*i; 
HC * 3 ; 

MEM = 2; 
PGUSEa24C*3; 

RTOG/ 
T* 

techcoflo; 
unitype; 

XII 
X2I 

r bs = xn 
r rt * x2; 



% 



FOR LINKAGE BY USE ROUTINES 

FOR LINKAGE BY USE ROUTINES 

DESTINATION IN RANDOM MOVE 

FIB ARRAY 

USED TO CALL COBOLFCR 

POINTER TO FIB 

FILE PARAMETER BLOCK 

DISK FILE HEADER 

DUMMY DATA DESC 

PR0 6 RAM USE ROUTINES 

1*1/0 DONE THIS ROUND 

TEMPORARY 

USED FOR TECH-C OVER FLOWS 

STORE UNIT TYPE FOR MANY TESTS 

*DO*NOT*SEPARATE XI & X2 THEY ARE 

USED IN CONJUNCTION FOR TECHC OFLOWS 

USED IN COMPUTING DISK ADDR 

USED IN COMPUTING DISK ADDR 



BADKEY 

BCOUNT 

BINARY 

BOUNDED 

BREAK 

BREAKOUT 

BUFFNUM 

BUFFSIZE 

BUFFSZ 

BUFSTATUS 

BUFTOP 

BUILDSTATNWD 

CHECSCCHECK1) 
ONERR(ONERRl) 

CLEARSTATUS 
CLOSFANDOPEN 



= P(0,N0T 

= FIBC133 
s FIB[63# 

* FIBC13] 

* FIRE9], 

* FIBE93 

a TFCRCOU 
P(0#Q 
« FIB [133 
s FIBC183 
= FIBC183 
= FIBC14I 
= FIB C 16 
sP(CST*TN 

P(DUP)C1 

■3 IF PCDU 

= ONERR 

*P(0*TIP> 

=PCMKS» 1' 

MKS#FL 



>NUMWDS> 
% THIS 

,C2<H1 J# 
C S $ 1 3 # * 

* $ 
NT MOD F 
*12>C0M* 
,[119] # 
•C3I15]# 
C8S8J103 

]## 

^SKIPAFT 
4S44543& 
F)*CCHEC 
lrl7>JC0M 
% THE A 

0*FL0C*4 
0C# itfll 



TlP*INX»0## 

INSERTS THE GROUP MARK 

, * BAD KEY RANDOM DISK 

% BLOCK COUNT 
» % 1*BINARY#Q*ALPHA 

% TRUE IF BOUNED FROM ABOVE 
f % BREAKOUT RESTART POINT 
lBC93)a»0 THEN 
DEL>OEL)#*% CALL BREAKOUT 






54 



X # OF BUFFS REQUSTED 
% BUFFER SIZE (REQUESTED) 
% SIZE FOR CONCATINATES 
* STATUS AFTER SEEKDC 
% USED ON 1*0 AND RANDOM 
% BUILD STATION WORD FOR DC 
(TUNR*TUNRH9»44S43)#* 
Kl) THEN P(CHECK1*0*FLQC,#> 
>DEL>DEL*DFL*DEL)* P(DEL)#» 
BOVE ARE USED ON BLOCK+REC CHKS 

% CLEAR BUFFC03 FOR WRITE 
>FlLECTRLf %CLOSE NO RWD 
ECTRL)#, % OPEN INPUT 



02690000 

segment; DISK 

02690020 
02690040 
02690060 
02690080 
02690100 
02690120 
02690140 
02690160 
02690180 
02690200 
02690220 
02690240 
02690260 
02690280 
02690300 
02690320 
02690340 
02690360 
02690380 
02690400 
02690420 
02690440 
02690460 
02690480 
02690500 
02690520 
02690540 
02690560 
02690580 
02690600 
02690620 
02690640 
02690660 
02690680 

02690700 
02690720 

02690740 
02690760 
02690780 
02690800 
02690820 
02690840 
02690860 
02S90880 
02690900 
02690920 
02690940 
02690960 
02690980 
02691000 
02691020 
02691040 
02691060 
02691080 
02691100 



T 0000 
ADDRESS 






T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 



0000 
0000 
0000 
0000 
0000 
0000 
0000 

0000 
0000 
0000 

0000 

OOOQ 

0000 

0000 
0000 
0000 

0000 

0000 

0000 

0000 
0000 
0000 

0000 
0000 
0000 

0000 

0000 
0000 

0000 
0000 
0000 

0000 

0000 

0000 

0000 
0000 

0000 

0000 

0000 
0000 
0000 

0000 

0000 
OOQO 
0000 
OOOQ 
0000 
0000 
0000 
0000 

0000 
0000 

0000 
0000 

0000 



50 

SO 
SO 
10 
»0 

10 
10 

SO 
«0 

10 

JO 

so 
SO 
so 
so 
so 
so 

$0 

so 
so 
so 

50 
$0 
50 

so 

50 

so 

50 
50 

so 

SO 

so 
so 
so 
so 
so 
so 

so 
so 
so 
so 

SO 
so 
so 
so 
so 

«0 

so 
so 
so 

SO 

so 
so 
so 

SO 

so 



00263 



• 
• 







COUNT 
0C8UFRL3 

DELAY 
DONE 
DISK 
FNAM 

ENOFILE 
ENDPROCESS 

ENDREEL 
EOF 

FOREVER 

EXPAND 

EXPANDSTATU5 

GETSEG 

HASH 



HASHTOT 

HOWOPEN 

INVALIDUSER 
IOERRCIOERRD 

IOMASK 

LA8EQ 

LASTDONE 

LASTIO 

LBLPTR 

LINEPRINT 

LSU8L 

LSUBU 

MAXR 

MAXREC 

NONSTD 

NUMBUF 

NUM8SPC 

numrec 

NXTREEL 

OPENIO 

OPTIONAL 

PARITY 

PRESENT 

PROPER 

PUNCH 

PURGE 

RANDOM 

RCOUNT 

READER 

READLBL 

RECPERBLK 



FI8C123 *> X USED FOR BLOCKING TECH*A*B 

P(NUMBUF,DL0C,16* X DATA COMM BUFFER RELEASE 

ll*COM*DEL*DEL'DEL>#* 



t TIP- C20I 13 *, 

■ T I P . C 19 I 1 3 #* 

= CUNITYPE*4) *, 
? FIB[43,[13U13#* 
= FIBC33. [40113 ** 
= FIBC53.[39*23#* 
= XH ** 

= <<*DL0O. [27*13)** 
= CNOT 0). [9*393 #* 
* *PC .EXPSTATAR) #, 

■ PCTlP*Q»0*EXPAND# 



% 
% 
% 
% 
% 



% 
% 

% 



"IF 



= IF 



THIS ALLOWS ONE CYCLE DELY 
\* 10 COMPLETED 
DISK IS UNIT TYPE OF 4 
FILE NAME INDEX IN FPB 
ALREADY PASSED EOF 
SEE OPTIONAL AND EN0FILE 
USED ONLY ON READ 
FIRST EOF OR EOT 
UNTIL END TIME 
EXPAND CELL CHECK 
EXPAND STATUS WORD 
27, COM, DEL, DEL* DEL* DEL)** 
PCFPBC(BS«-FNaM) + 3 3*FP8C8S3,FPB[8S + 13* 

T, H, 4, U, COM* DEL* DEL* DEL* DEL* DEL* DEL 5 #* 
NOT DISK THEN IF FI8[83>0 THEN 

PCMKS*FL0C**FIB[83*3*C0C)#* 
X ABOVE CALLS ROUTINES FOR HASH ACCUMULATON 
FIBC83 >0 THEN IF PCMKS, FLOC* *FIB[ 8 3* 0*COC ) 

CHECKS HASH TOTALS 
1»0PEN INPUT*0=? OPEN OUTPT 
1 > CLOSED 
INVALID USER NOT PARITY 



THEN IQERRCl8)#*X 
FIBC53,C4i:33#* X 



FIB[53<0#* % 

P(0,FL0C*I0ERR1*17*C0M,DEL*0EL*DEL)#* 
% ABOVE CALLS IOERROR ROUTINE 



= DEST tt 

* FIBC53.C17S13 #* 
= FI8[133. [21*13 #* 
« FIBC133,C46*1]#, 

- FLOCtU #* 
= UNITYPEsl OR UNITYPE=7 OR 

% 1- LP * 7 = PBT * 12 

* FIB C13 #, % LOWER 

* FIB [33 #* X 

* FIB[183[8*38*l03#*X 

- F1BC 183 , C 33 J 153 #* % 

■ FIB C53, [16* ill, 

* FIBC 133 • C 10S 93#* 

■ H[93,[43*53#* 
= FI8C 1 1 3 #, 

* P(MKS*2*1*FL0C*4* 

FILECTRL)#* X 

* FIBU33, [22*13** % 
~ FIB[ 53,[39;l3#* X 

* TlP.C28il3#* X 
*CC*DLOC),[2*13}#* X 
=21+C0DE+C0DE+REVERSE#*X 
= UNITYPE*6#* % UNIT IS 



X HAS IOMASK TO SAVE G-REL 
X LABEL EQUATED FROM DISK 
X NOT OF LAST OPERATION DONE 
XLAST WAS PHYSICAL READ 
% LABEL POINTER 

UNITYPE=12 #* 

« PBD 

80UND FOR RANDOM 

UPPER BOUND FOR DISK REC 

MAX REC SZ FOR CONCATS 

MAX REC SZ 

NON-STANDARD LABELS 

NUMBER OF BUFFERS ASSIGNED 

ROWS SPECIFIED XCJC 020 

RECORDS PER BLOCK 

THIS DOES REEL SWITCHING 



I" OPEN INPUT-OUPUT (DISK) 

OPTIONAL FILE NOT PRESENT 

PARITY BIT ON DESC 

CHECKS PRESENTSBIT 

GENERATES PROPER IOERR 
CARD PUNCH XTR 830 I 



= TIMEOUT, [FF3XQ** X TRUE IF LINE TO BE PURGED 

■■ TECHCOFLOff* X 1 a RANDOM DISK 

* FIBC73 #* X RECORD COUNT 

"(UNITYPE MOD ll*0)**X O'READER 1 l'PSUDOREADER 

=PCDLOC INX 0,11*11 % THIS READS THE LABEL. 

,COM,DEL,DEL)#* X 
= H[03. [30*123 #* % RECORDS PER BLOCK 



02691120 

02691140 

02691160 

02691180 

02691200 

02691220 

02691240 

02691260 

02691280 

0269U00 

02691320 

02691340 

02691360 

02691380 

02691400 

02691420 

02691440 

02691460 

02691480 

02691500 

02691520 

02691540 

02691560 

02691580 

02691600 

02691620 

02691640 

02691660 

02691680 

02691700 

02691720 

02691740 

02691760 

02691780 

02691800 

02691820 

02691840 

02691860 

02691880 

02691900 

02691920 

02691940 

02691960 

02691980 

02692000 

02692020 

02692040 

02692060 

02692080 

02692100 

02692120 

02692140 

02692160 

02692180 

02692200 

02692220 
02692240 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 



i 

i 
i 



i 
t 

« 



• 
• 






* 1 



* » 



€ 






• 



REMOTEIO 



REMQTEREAD 
REMOTEWRIT 

resetparity 
resetreaobit 
reverse: 
rotatebuf 

ROWLGTH 

SANOBKEY 

SEEKDC 

SEEKEY 
SERIAL 

segperblk 
setpresentsbit 

$ SET OMIT = NOTCTIMe 



SHA 



3 

= ( 
= ( 



• 



SLEEP a 

$ POP HMIT 
* SET OMIT s TIMESHARING 

TAPEE 

TECH 

TECHA 

TECHC 

TERMCTERM1 ) 

TIP 

TOTREC 

UNLABELED 

UT 

WAITDC 

WAITIO 



WOROSLEFT 
WRITEAFTEREOF 
WRITBACK 
LABEL LPRETURN»IOUTji 
LABEL IMPROPER'DCPRL 
LABEL DATACOM»RANDOM 
START : 

FIB 
IQM 
IF 
BEGIN 



P(BUFFSI 

FOREVER' 

KEY«0*CF 

DEL*DEL' 

P (BUFFS I 

("13)*CO 

PCTIP'NU 

LINES^KE 

DLOCC03 

0C24*24 

FIBC53. 

PCNUMBUF 

'COM'DE 

HC13#* 

FIBC 133 

PCO&NUMW 

&CHNNL 
FIBC 133 

FIBU3. 

H[03.[4 
PCTIP OR 
RING) 

36 #* 



ZE*DLO 

C IF CO 

X>TlP> 

DEL'DE 

ZE^TIP 

M#0'RT 

MWOS 

Y*CFX» 

«-TlP&0 

513#» 

[44? 13 

*OLOC, 

L'DEL' 



C* 
DE TH 

CODE* 
L'DEL 

N)## 

*8,p 

0*C"1 

[28*2 

*> 
13M1 

DEL)# 



% READ & WRITE BATCH SYSTEM 
EN LINES ELSE 1)* %F0R 
36*C0M» XREMQTE OR 

*1#SUB»RTN)##%TYPE 19 FILES 
% READ FOR TSS 



•C19I23 #> 
DSC Hi 44*43 
[9544*43*01 
.C20J i 3 #, 
[27533=0 #* 
2«63 #, 
MEM »DLQC» 



% WRITE FOR TSS 
t)#COM#OEL»RTN)#* 
8*13#*%RE5ET PARITY BIT 
% USED TO TURN OFF READ 
% l'REVERSE 

% ROTATES BUFFERS WITH 
ft NO I/O 

% ROW LGTH FROM HEADER 

% SEEK AND BAOKEY 

% DATA COM SEEK AND XlT 

oc*5»ii*eoM,xm#* 

% SEEK WAS DONE 
% FILE ACCESS - SERIAL 
% SEGMENTS PER BLOCK 
♦)##% SET PRESENCE BIT 



DISK 
BIT 



STAR 
»FIX 

io; 



TIP.C7 
FIBC53 
FIBC53 
FIBC53 
PC1#FL 
(*DLOC 
HC73 
CFIBC4 
CFIBU 
P(DLOC 
SLEE 
PCDLOC 
LEEP'C 
FIBC 17 
FISC 13 
FIBC 13 
T*I0D0 
STATNW 



8 1 3 # * 

.[46523 

.[46*23= 

.[46523= 

0C*TERM1 

) t, 

3. [2SU) 
3 ,[8543) 
'IOMASK* 
P*C0M*=) 
* IQMASK, 

OM#QEL*D 

3#> 

3. [4452] 

3.C23I1] 

NE'RANDO 

0# DIDDLE 



* 1 
*» %TEC 
1) #>% T 
3) #»% T 
#17#C0M) 

% L 






% 
% 
% 
% 

# f % 

% 

EL)#>% 



% F 



#* 

MLBL'SEE 
'DIDDLEW 



- TAPES 0*ALL ELSE 
HNIQUE 

echnique-a 

echnique-c 

#,%terminate i/o error 

oad i/o desc 

otal records on file 

nlabeled file 

ardware type 

his sleeps on i/o comple 

nd leaves a false on stk 

his sleeps on i/o 

aiting for a complete 

qrds left in buffer 

lag to say write back 

krtn'setup; 

rt*serialio#eqfsetck; 

%CUBE XIX I 



end; 

BEGIN 
FIXSTATNWDl 

end; 



IF 



♦ *(FLOC «■ (NOT 2) 
ASK *■ 02000000000; 
CODE THEN 

RTOG «• (-4)i 

CLEARSTATUS; 

GO TO FIXSTATNWDL 

8UFSTATUS=0 THEN 
RTOG «■ 1* 

buildstatnhd; 
go to dcprl; 



i nx oloo; 

% DC WRITE 
% SET ALG0LI0 



FOR C0B0LDCWR 



% SET ALGOLIO FOR READC 



02692260 
02692280 
02692300 
02692320 
02692340 
02692360 
02692380 
02692400 
02692420 
02692440 
02692460 
02692480 
02692500 
02692520 
02692540 
02692560 
02692580 
02692600 
02692620 
02692640 
02692660 
02692680 
02692700 
02692720 
02692740 
02692800 
02692820 
02692840 
02692860 
02692880 
02692900 
02692920 
02692940 
02692960 
02692980 
02693000 
02693020 
02693040 
02693060 
02693080 
02693100 
02693120 
02693140 
01693160 
02693180 
02693200 
02693220 
02693240 
02693260 

02693280 
02693300 

02693320 
02693340 
02693360 
02693380 
02693400 
02693420 



T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 
T 
T 
T 
T 
T 



0000*0 
0000»0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0002*2 
0004 '3 
0005*2 
0005*3 
0007*1 
0008*1 
0010*0 
0010*0 
OOll 50 
0012*1 
0015*2 
0016*0 



• 



IF DELAY THEN % THIS IS USED TO INHIBIT BUFFER 

DCBUFRLS; % ROTATION ON 1ST READ 
IF TIMEOUT < THEN % UNTIL- END READ 
BEGIN WAITDCI % THIS LEAVES ON STACK 
DLOC[0]* TIP&H20U7I1J; % SET DELAY 

END ELSE BEGIN 

P(BUFSTATUS); % SET ALGOLIO FOR READSQUGHT 
DCPRL5 P(IF TIMEOUT < THEN FOREVER ELSE TIMEOUT, CCM 

X604C PURGE Kll47tn#XCH,DL0C*15-RT0G#ll# COM* 

del*del»del»1»^)j %this leaves 1 or on stack 
end; %depending on how iq was, 

ExPANDSTATUS* 

%THIS ORS RESULTS OF ABOVE WITH 
% PRESENTS BIT AND IS RETURNED TO 
% PROGRAM, 



if expand * then 
p(present>not#or); 
setpresentsbit; 



END 



pcrtn); 
coboldc; 



0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 
0269 



3440 T 

3460 T 

3480 T 

3500 T 

3520 T 



3540 
3560 
3580 
3600 
3620 
3640 
3660 
3680 
3700 
3720 
3740 
3760 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SI 



0016»0 
0017*0 
0020*1 
0021S0 
0022*3 
0024*3 
0025*1 
0025*3 
0028*2 
0033*2 
0034*3 
0034*3 
0039*1 
0040*3 
0042*1 
0042*1 
0042*2 
ZE* 0043 



• 
• 



WORDS 



« 
t 

ft 



PROCEDURE COBOLIO* 






BEGIN 






REAL CODE 


s 


-H 


NAME DLOC 


s 


-21 


REAL NUMHOS 


= 


-3* 


KEY 


» 


-4# 


expstatar 


s 


-Up 


CHNNL 


s 


*4* 


LINES 


- 


-5* 


TIMEOUT 


s 


"5 * 


SKIPAFT 


s 


-6 



MNTEGER 



HLOCALS 



STATN « -6* 
TUNR s *7; 
ARRAY MKSCW»^4[*3; 

REAL CQBOLCONTROU-23; 
REAL C080LINDEX *22l 
REAL DEST ; 
ARRAY FIB E*3* 
REAL FILECTRL =12 J 
NAME FLQC; 
ARRAY FPB a 3[*3J 
ARRAY HC * 3 ; 

REAL iomask; 

NAME MEM = 2} 

ARRAY PGUSE=24C*3* 

REAL RT0G* 

PEAL T> 

REAL TECHCOFLOi 

REAL UNITYPE* 

REAL XI* 

REAL X2> 
INTEGER BS = XII 



START OF REL 

% 0*READ»l*WRITE#2*SE£K*6aWRTBLK* 

* POINTS TO BUFFER I/O OESC 

% # WdS TO BE WRITTEN 

% RANDOM RECORD ADDRESS OR CARRAGE RTN 

% AREA TO EXPAND STATUS INTO 

% LP CHANNEL SKIP 

% # LINES TO BE SPACED 

% UNTIL PORTION OF DATA COM 

% l=SpACE AFTER PRINT 

% DATA COMM STATION (BUFFER) 

% DATA COMM TERMINAL UNIT 



USE ROUTINES 
USE ROUTINES 
RANDOM MOVE 



% for linkage by 
% for linkage by 
% destination in 
% fib array 

* used to call cobqlfcr 
% pointer to fib 

% file parameter block 
% disk file header 

* to save c*rel call 
% dummy data desc 

% program use routines 
% 1*1/0 done this round 

% TEMPORARY 

% USED FOR TECH-C OVER FLOWS 

% STORE UNIT TYPE FOR MANY TESTS 

% *DO*NOT*SEPARATE XI & X2 THEY ARE 

% USED IN CONJUNCTION FOR TECHC QF'LOWS 

% USED IN COMPUTING DISK ADDR 



02700000 
SEGMENT! DISK 
02700100 
02700200 
02700300 
02700400 
02700500 
02700600 
02700700 
02700800 
02700900 
02701000 
02701100 
02701200 
02701300 
02701310 
02701400 
02701500 
02701600 
02701700 
02701800 
02701900 
02702000 
02702100 
02702200 
02702250 
02702300 
02702400 
02702500 
02702600 
02702700 
02702800 
02702900 
02703000 
02703100 



T 0000*0 
ADDRESS s 



00265 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



€ 






• 



INTEGER RT : 
* SET OMIT e NOT SH/ 
DEFINE 

ARROW 

BAOKEY 

BCOUNT 

BINARY 

BOUNDED 

BREAK 

BREAKOUT 

BUFFNUM 

BUFFSI7E 

BUFFSZ 

BUFSTATUS 

BUFTOP 

BUILDSTATNWD 



« x2; 

tREDISK 



% USED IN COMPUTING DISK ADDR 



CHECK(CHECKl) = 

ONERRCONERRU = 

CLEARSTATUS sp 

CLOSEANDOPEN sP 

COUNT • 

DCBUPRLS « 

DELAY 

OONE = 

DISK = 

FNAM = 

ENDFILE = 

endprocess = 

ENDREEL 

EOF =( 

FOREVER =( 

EXPAND = 

EXPANDSTATUS = 

GETSEG = 

HASH =1 



= P(0#NOT 



FIBC133 

FIB[63# 
FIBC133 
FI8E9], 
FIBC9] 
IFCRCOU 
P(0*0 

FIBC133 
FIBC 18 3 
FIBC183 
FIBC 143 
FIB [16 
((STATN 

(DUP)Cl 

IF P(DU 

ONERR 



= P 

P 



HASHTOT =1 

HOWOPEN = 

INVALIDUSER 
IOERRClOERRD 

LABEQ 

LASTDONE 

LASTIO 

LBLPTR 

UINEPRINT 



CO*TIP* 

CMKS,1* 

MKS^FL 

FIBC 123 

PCNuMSU 

n*co 

TIP, [20 
TIP, [19 
CUNITYP 
FI8[43, 
FlBt53 • 
FIBC53. 
X2 ## 
(*OLOC) 
NOT 0). 
*P(,EXP 
PCTIP»0 
27, C 

PCFPBt 

T,H»4 

F NOT D 

X AB 
F FIBC8 

THEN 
FIBC53. 

FIBC53< 

pco,flQ 

% A8 
FIBC53. 
FIBC133 
FIBC 131 

FL0CC13 
UNITYPE 



,NUMWD 

% THI 

.C19J1 

,[2431 
C2H]# 

* # 
NT MOD 
,12*C0 
. C 1 : 9 3 
. C 3: 15 
[8:8*1 

t, 
3#, 

♦SKIPA 
a:44U 
P)*CCH 
1 * 1 7 , C 

% THE 
«■)## 
0*FL0C 
OC'l'F 

#, 
F,DLOC 
M*DEL* 
8 13 #* 
*13 *, 
E*4) * 
[13:11 
[40J13 
[39:23 

• C27U 
[9*393 

STATAR 
,0,EXP 
OM,DEL 
(BS:=F 
#11* CO 
ISK TH 
P 
OVE CA 
3 >0 T 
I0ERR( 
[41*33 

0## 

CIOER 
OVE CA 
[17:13 

•C21*l 

.[46*1 

#, 
= 1 OR 



S#TIP# INX**)#* 

S INSERTS THE GROUP MARK 



1#> 

3#i 



% 



DISK 



BAD KEY RANDOM 
BLOCK COUNT 
1«BINARY#0?ALPHA 
TRUE IF BQUNED FROM ABOVE 
BREAKOUT RESTART POINT 
FIB[93)»0 THEN 
M*DEL*DED#*X CALL 



% 

% 



BREAKOUT 



t> % # OF BUFFS REQUSTED 
J#» % BUFFER SIZE (REQUESTED) 
03#* % SIZE FOR CONCATINATES 

% STATUS AFTER SEEKOC 

X USED ON 1-0 AND RANDOM 
FT)« % BUILD STATION WORD FOR DC 
]&(TUNR*TUNR) [9*44*4 3 )#, 
FCK1) THEN P(CHECK1*Q*FL0C##* 
OM,DEL»DEL#DEL#DEL)> P(DEL3*# 
ABOVE ARE USED ON BLOCK+REC CHKS 

% CLEAR BUFF[03 FOR WRITE 
,4,FlLECTRL, XCLQSE NO RWD 
lLECTRL)## % OPEN INPUT 

% USED FOR BLOCKING TECH*A#8 
,16, % DATA COMM BUFFER RELEASE 
DEL, DEL)** 

X THIS ALLOWS ONE CYCLE OELY 

X 1* 10 COMPLETED 
, % DISK IS UNIT TYPE OF 4 
3## % FILE NAME INDEX IN FPB 

#, % ALREADY PASSED EOF 
#* % SEE OPTIONAL AND ENDFILE 

X USED ONLY ON READ 
])## % FIRST EOF OR EOT 

#, % UNTIL END TIME 
) #, X EXPAND CELL CHECK 
AND, % EXPAND STATUS WORD 
,DEL#DEL,DEL)## 
NAM)+3 3,FPB[BS3#FP8C8S*13, 
y, DEL, DEL # DEL* DEL, DEL* DEL )## 
EN IF FI8[83>0 THEN 
(MKS,FL0C**FIB[83*3*C0C)## 
LLS ROUTINES FOR HASH ACCUMULATON 
HEN IF P(MKS,FLOC**FIB[83»0*COC) 
18)#*X CHECKS HASH TOTALS 
#* % 1*0PEN INPUT*0* OPEN OUTPT 

X 1 > CLOSED 

% INVALID USER NOT PARITY 
R I, 17, COM* DEL* DEL* DEL )#* 
LLS IOERROR ROUTINE 

#* X LABEL EQUATED FROM DISK 
] #» X NOT OF LAST OPERATION DONE 
]#, XLAST WAS PHYSICAL READ 

% LABEL POINTER 
UNITYPE=7 OR UNITYPE«12 ## 



02703200 
02703204 
02703300 
02703400 
02703500 
02703600 
02703700 
02703800 
02703900 
02704000 
02704100 
02704200 
02704300 
02704400 
02704500 
02704600 
02704700 
02704800 
02704900 
02705000 
02705100 
02705200 
02705300 
02705350 
02705351 
02705400 
02705500 
02705600 
02705700 
02705800 
02705900 
02706000 
02P06100 
02706200 
02706300 
02706400 
02706500 
02706600 
02706700 
02706800 
02706900 
02707000 
02707100 
02707200 
02707300 
02707400 
02707500 
02707600 
02707700 
02707800 
02707900 
02708000 
02708200 
02708300 
02708350 
02708400 
02708500 



0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
OOOO'O 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 







i 
• 



• 



$ SET 



$ 
$ 



POP 
SET 



LSUBL 

USUBU 

MAXR 

MAXREC 

NONSTD 

NUMBUF 

NUMBSPC 

NUMREC 

NXTREEL 

OPENIO 

OPTIONAL 
PARITY 

PRESENT 

PROPER 

PUNCH 

PURGE 
RANDOM 

RCOUNT 

READER 

READLBL 

RECPERBLK 
REMOTEIO 



RE^OTEREAD 

REMOTEWRIT 

RE3ETPARITY 
RESETREAOBIT 
REVERSE 
ROTATEBUE 

ROWtGTH 

SANOBKEY 

SEEKDC 

SEEKEY 
SERIAL 

segperblk 
setpresentsbit 
omit = notctime 
sleep 

OMIT 

OMIT * TIMESHAR 

TAPEE 

TECH 

TECHA 

TECHC 

TERMCTERM1) 

TIP 

TOTREC 

UNLABELED 



SHA 



I 1UP » 7 s PBT 
FIB [U it, % 

FIB C 33 #> % 

FIB[183C8I38«103#»X 
FIBU83,[33*153## % 
FIB [53.C16J i3#, X 
FIBC133.C10} 9]#* % 
HC93,C«3t53## % 

FIBtin ## X 

P(MKS»2*l*Fl.0C»4* X 

FILECTRL>#* % 
FIBC 1 33 . C22: 1 3#* X 

FIBC 5 J . C 39 * 1 3#* X 

TIP.C28J13## % 
CC*OLQC>.C2*13>*> X 
21+C0DE+C0DE+REVERSE* 

UNITYPEs6#, % UNIT 

TIMEOUT, CFFl/O** * 
TECHCQFLQ#> X 

FIBC73 t> % 

(UNITYPE MOD 11*0)#*X 
PCDLOC INX 0*11*11 % 

*COM*DEL*DEL)## X 
HC03. [30*123 #* % 

P<BUFFSIZE,DLOC* X 
FOREVER* (IF CODE THEN 
KEY=0*CFX*TIP*CQDE*36 
DEL»DEL>DEL*DEL*DEL>1 
P<8UFFSIZE#TIP,1» 

C-13J*C0M,l*SuB#RTN) 
PCTIP»NUMWOS x8# % 
LINES*KEY#CFX#0#("1U 
0U0CC0UTIP40C28I28I 
0C24I24IU#, % 

FIBC53.E44U3 ** % 

pcnumbuf,dl0cm3m1 % 
,com,del*del*d£D#*x 

HC13#* % 

FIBC 1 33 . C 19X23 *• X 

PC0*NUMWDS[HI44I43 % 

&CHNNL C9*44*43,DL0C 
FIBC 133 . C20S 1 3#* % 
FIBC43. [27*33*0 #« X 
H[03. [42*63 #, % 

PCTIP OR MEM »0L0C*O 

RING) 
36 t* 



, 12 s PBD 
LOWER BOUND FOR RANDOM 
UPPER BOUND FOR DISK REC 
MAX REC 52 FOR CONCATS 
MAX REC SI 
NON-STANDARD LABELS 
NUMBER OF BUFFERS ASSIGNED 
ROWS SPECIFIED XCJC 020 
RECORDS PER BLOCK 
THIS DOES REEL SWITCHING 



Is OPEN I 
OPTIONAL 
PARITY 81 
CHECKS PR 
>% GENERA 
IS CARD P 

TRUE IF L 
1 a RANDO 

RECORD CO 
OsREADER 
THIS REA 



NPUT-OUPUT (DISK) 

FILE NOT PRESENT 

T ON DESC 

ESENTSBIT 

TES PROPER IOERR 

UNCH ITR 830 I 

INE TO BE PURGED 
M DISK 

UNT 
11"PSUD0READER 

DS THE LABEL. 



RECORDS PER BLOCK 
READ & WRITE BATCH SYSTEM 

LINES ELSE U# IFOR 
*COM, %REMOTE OR 

*SU8#RTN)#,%TYPE 19 FILES 

X READ FROM TSS 
# * X 

WRITE FOR TSS 
>COM*DEL'RTN)#* 
11##XRESET PARITY BIT DISK 
USED TO TURN OFF READ BIT 
1=REVERSE 

ROTATES BUFFERS WITH 
NO I/O 

ROW LGTH FROM HEADER 

SEEK AND BADKEY 

DATA COM SEEK AND XIT 
#5>11#C0M#XIT)#, 

SEEK WAS DONE 

FILE ACCESS =5 SERIAL 

SEGMENTS PER BLOCK 
*,% SET PRESENCE BIT 



ING 

= TIP, C7*13 t> 
- FI8C53.C46J23 *» 
=CFIBC53 ,C46*23=1) 
={FIB[53tC46*23x3) 



X 1* TAPES 
%TECHNIQUE 
#*X TECHNIQUE-A 
*>% TECHNIQUE'C 



0*ALL ELSE 



« PC1#FL0C»TERMU17#C0M)#,*TERMINATE I/O ERROR 

■ C*OLOC> *, X LOAD I/O DESC 

a HC73 #* X TOTAL RECORDS ON FILE 

= (FIBC43.[2:i3)#* X UNLABELED FILE 



02708600 
02708700 
02708800 
02708900 
02709000 
02709100 
02709200 
02709300 
02709400 
02709500 

02709600 
02709700 

02709800 
02709900 
02710000 
02710100 
02710150 
02710200 
02710300 

02710400 
02710500 
02710600 
02710700 
02710800 
02710900 
02710950 
O27U0O0 
02711100 
02711200 
02711300 
02711400 
02711500 
02711550 
02711600 
02711700 
02711800 
02711900 
02712000 
02712100 
02712200 
02712300 
02712400 
02712500 
02712600 
02712700 
02712800 
02712900 
02712950 
02713000 
02713200 
02713250 
02713300 
02713400 
02713500 
02713600 
02713700 
02713800 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
P 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 



0000*0 
0000»0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



LABEL 
LABEL 
LABEL 
SU8R0UT 



UT 
WAITOC 

WAITIO 

wordsl 

WRITER 
WRITEA 
WRITBA 
LPRETU 
IMPROP 
DATACO 

INE GOU 
BEGIN 



• 



END G 

SUBROUTINE MAY 

BEGIN 



EFT 
ARITY 

FTERE0F 

CK 

RN* IOUT 

ER*DCPR 

M#RANDO 

SE> 

CO 

P( 

OUSEJ 
BEPARIT 



s CFIBC 
= PCDLO 

SLE 

* PCDLO 
SLEEP* 

* FIBC1 
= FIBCS 

- FIBC1 
■ FIBC1 
>START> IOD 
L»FIXSTATN 
MIO^REREAD 

BOLINDEX ♦ 
MKS*T,C38« 



41 ,C8S 43 )## % HARD 
CMQMASK, % THIS 
EP*COM,9)#, % AND 
CMOMASK, % THIS 
COM,DEL*DEL)#/X WAIT 
7l#t % WORD 

3.C3:n*, % INDICA 

3].C23»1]#; % FLAG 
QNE'RANDOMLBL'SEEKRT 
WD,DIDDLE*DIDDLEWRT# 



WARE TYPE 

SLEEPS QN I/O COMPLE 
LEAVES A FALSE ON STK 

SLEEPS ON I/O 
ING FOR A COMPLETE 
S LEFT IN BUFFER 
TES FORCED REELSWITCH 

TO SAY WRITE BACK 
N*SETUPJ 

serUlio#eofsetck; 



% THIS CALLS USE ROUTINES 
T, C26J103; 

lO],CCOBOLCONTROL3); 



3STHIS EXECUTES THE 
% CODE SEGMENT 



END M 

SUBROUTINE MOV 

BEGIN 



SETPRESENTSBlT; 

IF CT *RT *PGUSECCDISK AND OPENIO )x3+93 . 1 1 1 233 )*0 

THEN GOUSE ; 
IF CT + FIB tl5],CH23]) *0 TH£N GOUSE; 
$ SET OMIT s NOT SHAREDISK 

IF RTOG THEN 

IF (T OR RT) = THEN I0ERR(19); 
AYBEPARITYJ 

REC; STHIS MOVES RECORDS TO&FRQM WORK AREA 

IF CODE i 4 THEN 

PCBUFTOP INX(BS*CN|jMWDS * (RCOUNT MOD NUMREC)) + D> 
ELSE 

P(XCH); SPICK UP VALUE LEFT FROM SERIALIO 
PCBUFTOP INX CBUFFSIZE * 2)U SFIND END OF BUFFER 
DEST := IF CODE THEN P CXCH) ELSE p; 

STREAM CFR0MJ=PJNUMWDS#ES s: NUMWDS,C36l6]* XXSsDEST); 
BEGIN 

si*from; ecds*32Wds;ds*32wdsj; ds*numwds wds; 
end; 

IF CODE THEN DEST (s P 
ELSE BEGIN 

pcdel); 

IF CODE=0 AND PARITY THEN 
BEGIN 

$ set omit * not sharedisk 

maybeparity; 
end; 
end; 
dl0cc03 «■ tip& 0estc33:33»153 
ovrec; 

ddlerec; % this routine gets the next record 
begin % for all serial files (read & write) 

WORDSLEFT «• T > 

DLOCCO] «- NUMWQS INX Tip; 

RCOUNT * *PCDUP) + l; 

IF BREAK THEN BREAKOUT; 

IF PARITY THEN MAYBEPARITY; 

end diddle; 
s set omit ■ not sharedisk 



END M 
SUBROUTINE DI 



02713900 

02714000 

02714100 

02714200 

02714300 

02714400 

02714410 

02714450 

02714500 

02714600 

02714700 

02714800 

02714900 

02715000 

02715100 

02715200 

02715300 

02715400 

02715450 

02715500 

02715600 

02715700 

02715709 

02715800 

02715900 

02716000 

02716100 

02716200 

02716300 

02716400 

02716500 

02716600 

02716700 

02716800 

02716900 

02717000 

02717100 

02717200 

02717300 

02717400 

02717500 

02717510 

02717519 

02717530 

02717540 

02717600 

02717700 

02717800 

02717900 

02718000 

02718100 

02718200 

02718300 

02718400 

02718500 

02718600 

02718604 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

ooono 

0002*1 

0003*2 
0003*3 

0004*0 

0004*0 

0005*2 

0010*1 

0012*0 

0016*0 

0016*0 

0016*1 

0020*2 

0020*3 

002i*0 

0021*3 

0025*2 

0025*3 

0026*2 

0028*3 

0030*3 

0032*3 

0032*3 

0034*3 

0035*0 

0035*3 

0036*3 

0037*0 

0039*0 

0039*2 

0039*2 

004110 

0041*0 

0041 *0 

004jl3 

0042*3 
0043*0 
0043*0 
0044* 1 
0045*3 
0047*3 
0053*0 
0056*0 
0056*1 



i 
i 
% 
% 






SUBROUTINE PREL' % THIS DOES ACTUAL I/O 

BEGIN 

IF NOT (RT LSS 0) THEN 
BEGIN 

pc tip#dloo; 

if writback then % do special write'io 

begin writback «- false; % turn off read bit 
dlqcr03<- tlp&resetreaobitu to make write 

ENOJ 

pcprl*del)j % do i-q 

end; 

BCOUNT <■ *PCDUP) + crtoou; %COUNT BLOCK&SET I0T0G 
IF CODE * 2 THEN GO TO SEEKRTN; 
RCOUNT «• *PCDUP) + 1; % COUNT RECS 

IF NOT DONE THEN 
$ SET OMIT = NOT SHAREDISK 

waitio; 

if break then breakout; 

END PREl; % ON NEW QESC 

SUBROUTINE REFLECTCHECKER ; % WRITE PARITY ROUTINE 

BEGIN 

IF NOT EOF THEN %TAPE WRITE PARITY OR BLANK TAPE 
BEGIN 
IF OPENIO AND DISK THEN IF( T*PGUSEC 12 3 , 1 1 1 23 3 ) *Q 

THEN GOUSE ELSE ELSE 
IF CT«-PGUSEC93,[24*243)/0 THEN GOUSE; 
IF CT*FlBtl5].[ll233) i THEN GOUSE; 
TERMC20); 

end; 
setpresentsbit; % make desc present 
if not disk then nxtreel;* reel switch 
end relectchecker; 
subroutine skipper; % this odes skipping qn line printer 

begin numbuf * 1 ; % inhibit buffer rotation 
if chnnl i then lines ** h 
dlocco] «• tip & 1 [18*47113 

&c16+chnnl) c27i42i63; 
for t*2 step 2 until lines do 

BEGIN 

prel; 

if not present then if eof then setpresentsbit 
else reflectchecker; 

END; 
IF LINES THEN 
BEGIN 
DL0CC03* TIP & (2'(2x(CHNNL^0)))C27J46t23; 

prel; 

if not present then if eof then setpresentsbit 

else reflectchecker; 
end; 
numbuf * buffnum; % restore buffer for rotation 
end skipper; 
subroutine revread; % this does a read reverse 

begin dl0cc03 «• flag (fib [163>; 
prel; 

FIBC16], [33*15]* TIP; 
WQRDSLEFT «- MEM [1 InX TIP3; 



02718700 


T 


0056*1 


02718800 


T 


0057*0 


02718900 


T 


0057*0 


02719000 


T 


0057*3 


02719100 


T 


0058*1 


02719200 


T 


0059*0 


02719300 


T 


0060*0 


02719400 


T 


0063*0 


027i9500 


T 


0065*0 


02719600 


T 


0065*0 


02719700 


T 


0065*3 


02719900 


T 


0065*3 


02719950 


T 


0068*1 


02720000 


T 


0069*2 


02720100 


T 


0071*2 


02720109 


T 


0072*3 


02720150 


T 


0072*3 


02720200 


T 


0074*3 


02720300 


T 


0080*0 


02720400 


T 


0080*1 


02720500 


T 


0081*0 


02720550 


T 


0081*0 


02720570 


T 


0082*1 


02720600 


T 


0082*3 


02720605 


T 


0086*3 


02720610 


T 


0089*2 


02720620 


T 


0094*0 


02720650 


T 


0098*0 


02720670 


T 


0099*1 


02720700 


T 


0099* 1 


02720800 


T 


0100*3 


02720900 


T 


0103*2 


02721000 


T 


0103*3 


02721100 


T 


0104*0 


02721200 


T 


0106*2 


02721300 


T 


0108*2 


02721400 


T 


0109*1 


027215QO 


T 


0112*0 


02721600 


T 


0113*0 


02721700 


T 


0113«0 


02721800 


T 


0114*0 


02721810 


T 


0118*3 


02721900 


T 


0120*0 


02722000 


T 


0122*1 


02722100 


T 


0122*2 


02722200 


T 


0123*0 


02722300 


T 


0126*2 


02722400 


T 


0128*0 


02722410 


T 


0132*3 


02722500 


T 


0134*0 


02722600 


T 


0134*0 


02722700 


T 


0137*1 


02722800 


T 


0137*2 


02722900 


T 


0138*0 


Q2723000 


T 


0139*1 


02723100 


T 


0140*0 


02723200 


T 


0142*1 



i 
i 
i 

€ 

i 
i 
t 



• 
# 



»' » 



end; 
subroutine readrev; 

BEGIN IF 



NOT TECHA 
BEGIN 

Revread; 

DIQC C03 
END 



% THIS 
THEN 



HANDLES A READ REVERSE 



«• N0TCW0RDSLEFT-2) INX TIP*' 



ELSE 



IF 



CWQRDSLEFT 1= T) LEQ THEN 
BEGIN 

revread; 

DLOCC03 * 
END 
ELSE BEGIN 

DLQCCO]* NQTCNUMHDS-DINX 



CNOTCMAXREC - 2 )INX TlP)&MAXRj 



CTIP 



END 
SUBROUTINE ERROR; 
BEGIN 



*(NOT TIP) C2I26M3); 
RCOUNT «• *P(DUP) + II 
END ; 
IF NOT PRESENT THEN 
BEGIN 

setpresentsbit; 

if eof then 

BEGIN 

ENDFILE ♦ TRUEI 

HASHTOTI 

P (1*HTN)| 

end; 
if (t <-pgus e c9]&fib[153 e25j1s23] 3^0 then gousei 
if rtog then ioerr (29)1 
end; 

READREVj 



IF EOF THEN 
BEGIN 

BCOUNT «• *P(DUP) - i; 
RCOUNT ♦ *P(DUP) - I! 
ENDFILE * TRUE! 
SETPRESENTSBIT; 
IF READER THEN P(1,RTN)J 
IF NOT UNLABELED THEN 
BEGIN 

ENDREEL * = FALSE; 
IF NOT DISK THEN 
BEGIN 
READL8L! 

streamcsent*-o,bc«-o,rc<-q>wp<-o*l«-lbLptr); 

BEGIN % THIS RETRIVES END 






loc sent;* of Reel 

DI +7; % BLOCK & 
L I SI *SI+39; 

chr;ds«-5 octidS*7 ocT; 
01*7} os «• chr; 



DI * 
Dl * 
SI «■ 

dS «. 

Dl *• 

end; 
.IF P«l then writeparity 

CHECKcRCOUNT) 0NERR(16)| 
CHECKCBCOUNT) 0NERRU7); 
ENDREEL 4- P ; % THIS STORES 



SENTINAL, 
REC COUNT 



true; 



sentinal 



02723300 


T 


0145*0 


02723400 


T 


0145 11 


02723500 


T 


0146*0 


02723600 


T 


014712 


02723700 


T 


0148*0 


02723800 


T 


0149*0 


02723900 


T 


0151*2 


02724000 


T 


013112 


02724100 


T 


0151*2 


02724200 


T 


0153*3 


02724300 


T 


0154*1 


02724400 


T 


0155*0 


02724500 


T 


0159*1 


02724600 


T 


0159*1 


02724700 


T 


0159*3 


02724800 


T 


0161*1 


02724900 


T 


0163*2 


02725000 


T 


0165*2 


02725100 


T 


0165*2 


02725200 


T 


0166*3 


02725300 


T 


0167*1 


02725400 


T 


0168*3 


02725500 


T 


0169*3 


02725600 


T 


0170*1 


02725700 


T 


0172*3 


02725800 


T 


0178*2 


02725900 


T 


0179*0 


02726000 


T 


0179*0 


02726100 


T 


0183*0 


02726200 


T 


0185*3 


02726300 


T 


0185*3 


02726400 


T 


0186*0 


02726500 


T 


018610 


02726600 


T 


0187*0 


02726700 


T 


0187*2 


02726800 


T 


0189*2 


02726900 


T 


0191*2 


02^27000 


T 


0194*0 


02727100 


T 


0195*2 


02727200 


T 


0197*3 


02727300 


T 


0199*0 


02727400 


T 


0199*2 


02727500 


T 


0200*1 


02727600 


T 


0201*0 


02727700 


T 


0201*2 


02727800 


T 


0203*2 


02727900 


T 


0206*0 


02728000 


T 


0206*1 


02728100 


T 


0206*2 


02728200 


T 


0206*3 


02728300 


T 


0207*1 


02728310 


T 


0208*0 


02728400 


T 


0208*2 


02728410 


T 


0208*3 


02728500 


T 


0212*1 


02728600 


T 


0216*3 


02728700 


T 


0221*1 








LBLPJR); 






SUBROUTINE 
BESlN 



IF CT«.FIB 

IF CT-FIB 
END ; 
IF NOT ENDREEL 
BEGIN 

IF CT«- FIB 
IF (T*. FIB 
R(1*RTN); 

end; 
end; 

IF NONSTD THEN 
BEGIN 

enofile := false; 
closeandqpen; 

PCl*RTN)i 

end; 

NXTREEUi 

pcoel#ded; sdelete 
writeparity «, false; 
go to start; 
end; 
maybeparity; 
end error; 
diskaddress; sthis computes 



IF NOT WRITEPARITY THEN 
BEGIN 

hashtoT; 

IF (T<.PGUSE[33,[ 1*23])/ 
IF CT«-PGUSE[33,t24*243)X 

end; 

END 
ELSE STREAM (RECTOT* TOTREC + 1 
LABL * 
BEGIN 

SI «• LOG RECTOT 
DI ♦ 01 ♦ 45; 
OS * 7 DEC; 
end; 

IF NOT ENDREEL THEN 

IF PGuSECBS«-(DISK 
THEN BEGIN 

if ct*pgusecbs],[ 
if ct*pgusecbsj, 
end; 

IF NOT DISK THEN * END 
IF NOT WRITEPARITY THEN 
BEGIN 

C 3 3 * C H233)*o THEN 
C33.C24*243)*0 THEN 



THEN 
THEN 



GOUSEj 

gouse; 



AND OPENIO)x9+23XO 
1*233)/G 



THEN 
THEN 



gouse; 
gouse; 



OF REEL USE ROUTINES 



gouse; 
gouse; 



THEN 

C23 . C l*233)/0 
C23.t24*243)*0 



THEN GQUSe; 
THEN GOUSe; 



branch returns 



THE DISK ADDRESS READ 9. WRIT 



$ SET OMIT = 



IF CODE 
IF PCRT 
BEGIN 
NOT SHAREDISK 
PCl*RTN); 

end; 

IF CT<- P + JO) 
IF (85 * HCT3) 
BEGIN 



THEN RT * SEGPERBLK x BCOUNT; 
DIV RQWtGTH,DUP) G EQ NUMBSPC THEN 



LSS 
a 



10 THEN 
THEN 



t*io; 



02728710 J 
02728720 T 
02728800 T 
02728900 T 
02729000 T 
02729010 T 
02729*00 T 
02729200 T 
02729300 T 
02729^00 t 
02729500 T 
02729600 T 
02729700 T 
02729800 T 
02729900 T 
02730000 T 
02730100 T 
02730200 T 
02730300 T 
02730400 T 
02730500 T 
02730510 T 
02730600 T 
02730700 T 
02730800 T 
02730900 T 
02731000 T 
0273H00 T 
02731200 T 
02731300 T 
02731400 T 
02731500 T 
02731600 T 
02731700 T 
02731800 T 
02731900 T 
02731950 T 
02732000 T 
02^32100 T 
02732200 T 
02732300 T 
02732310 T 
02732400 T 
02732500 T 
02732600 T 
02732700 T 
02732705 T 
02732710 T 

02732715 T 

02732716 T 

02732717 T 

02732718 T 

02732721 T 

02732722 T 

02732723 T 
02732725 T 
02732730 j 



022l»3 

0223*0 

0223*2 

0229! 1 

023212 

0236*1 

0237*0 

0237*0 

0238*3 

0240*0 

0240*0 

0240*1 

0240*2 

0240*3 

0241*0 

0241*2 

0245*3 

0246*3 

0250*0 

0253*1 

0254*0 

0254*3 

0256*2 

0257*0 

0261*0 

0265*0 

0265*0 

0265*2 

0266*0 

0270*0 

0274*0 

0274*2 

0274*2 

0274*2 

0275*2 

0276*0 

0278*2 

028 j *0 

028l?2 

0281*2 

0283*0 

0283*2 

0286*0 

0286*2 

0286*2 

0288*0 

0288*1 

0289*0 

0289*0 

0292*0 

0294*2 

0295*0 

0295*0 

0295*2 

0295*2 

0298*1 

0299*3 



i 

< 
i 
i 

< 
i 

i 



"'WKEHWaMMiiPfNM 







« ■» 



then 



getseg; 

IF INVALIDUSER 
BEGIN 

maybeparity; 

END? 

if howopena'o then if not open 10 then i0errc22)* 
bs <- hcti; 

END) 
STREAMC A *• BS * 8S + RT MOD ROWLGTH* 

B<-T<-BUFTOP,tCF]-CiF CODE THEN ELSE WRlTBACK))J 

begin si*toc a; os<-8 dec; end; 

SET OMIT = NOT SHArEDISK 

end diskaddress; 

% this writes a record 
techc then 

BEGIN 

STREAM (A «• TIP, B «- CXI 3 )J 

BEGIN 

SI •■ a; DI * DI 
DI * DI 

END' 
TECHCOFLO «-l&TlPtl8«33«l5]4NUMWDS[3»33U5j* 

NUMWDS * -WORDSLEFT +CWOROSLEFT <- BuFFSIZE)* 

0LOCC03* FUAG(FlBtl6] & NUMWDSC8 * 38 $ 103 )! XTR840 

END 

BEGIN 

COUNT * NUMREC) 

NUMWDS* CWORDSLpFT <• BUFFSIZE) 



$ 



SUBROUTINE WRIT; 
BEGIN 



IF 



+ 4J 

+ 4j 



DS 
DS 



4 

4 



chr; 

CHRJ 



ELSE 



IF 
IF 



- T } 

CHNNLJ 



XTR 830 I 



PUNCH THEN FlBC 16] , t 32 I 1} * 
DISK THEN 
BEGIN 

lASTlQ «. 01 

XTHIS COMPUTES THE AMT OF DISK USED IN ROWS 
IF (RCOUNT+1) DIV RECPERBLKxSEGPERBLK DIV 
RQWLGTH GEQ NUMBSPC THEN 
(RCOUNT + OPENIO) DIV 
RECPERBL.K x SEGPERBLK DIV RQWLGTH 
NUM8SPC THEN 



IP 



GEQ 
BEGIN 
IF OPENIO 



THEN RCOUNT * *PCDUP) ♦ CSERIALJJ 



COUNT * OJ 



THEN COUNTED 
FLAGCBUFTOP 



S SET OMIT n NOT SHAREDISK 

ELSE 



PU*RTN> 

END ELSE 

if serial 

DL0CC03 *■ 
P(CODE); 

code ♦ u 
diskaddress; 

CODE * p; 

END 

IF LINEPRINT THEN 
BEGIN 

IF NOT SKIpAFT THEN 
BEGIN 

SKIPPER) 

LINES «- CHNNL* OJ 



ELSE BADKEY«-TRUEJ 

i, PESETREADBITJJ 



02732740 
02732742 
02732744 
02732746 
02732748 
02732750 
02732760 
02732765 
02732770 
02732775 
02732780 
02732784 
02732795 
02732800 
02732900 
02733000 
02733100 
02733200 
02733300 
02733400 
02733500 
02733600 
02733700 
02733750 
02733800 
02733900 
02734000 
02734100 
02734150 

02734200 
02734300 
02734350 
02734400 
02734500 
02734600 
02734700 
02734800 
02734810 
02734820 
02734830 
02734835 
02734840 
02734900 

02735000 
02735100 
02735200 
02735300 
02735400 
02735450 
02735599 
02736100 
02736200 
02736300 
02736400 
02736500 
02736600 
02736700 



0300*1 
030750 
0308*0 
0308*2 
0310*0 
0310*0 
0315*3 
031613 
0316*3 
0319*0 
0323*2 
0324*1 
0324*1 
0324*2 
0325*0 
0326*2 
0327*0 
0328*1 
0328*1 
0329*0 
0329*2 
0329*3 
0332*1 
0335*3 
0338*0 
0338*0 
0338*2 
0340*0 
0343J0 
0346*3 
0347*2 
0348*0 
0350*2 
0350*2 
0354*0 
0356*0 
0358*1 
036H0 
0362;3 
0363*1 
0367*1 
0369*1 
0369*3 
0369*3 
0376*2 
0378*3 
0379*0 
0379*3 
0381*0 
0381*2 
038H2 
0381*2 
0384*3 
0385*1 
0385*3 
0386*1 
0387*0 



€3 

• 



n 



SETUP* 



go to setup; 
end; 
if cchnnl /o) or (lines < 2) then 

dlqcc03* flagcfibc16ulines [27*47*13 

&UINES [2814611] 
&CHNNU C29«44*43) 
ELSE BEGIN 

DLOCCOl * FLAGCFIBC16]&6>20 [27*42*6]); 

prel; 

if not present then reflectchecker; 

lines «• lines - 2> 

skipper; 

go to lpreturn; 

end; 

END LlNEPRINTER 

DL0CC03 «■ FLAG(FlBtl6]&NUMWDSC8*38J10]); 



LPRETURN* 



BINARY THEN ARROW* 
THEN TERMC69); 



& maxr; 



ELSE 

end; 
if tapee then if not 
if disk and 8s < 100 
prel; 

FIBC16], [33115] * Tip; 
DLOCCO] ♦ (DISK) INX TIP 
IF TECHCQFLO THEN 
BEGIN 
STREAM (I *■ CXn#A*NUMWDS*TECHC0FLQiC3U53» 

B «- TECHCQFLO. C18*153> K «-NUMWDS , t 36 *63 * 
X * TIP OR MEM ?; 
BEGIN 

si * g; 

kcds 4, 32 wds;ds«- 32 wos); 

ds «■ a wds; 

si * u oi * x; si *si+4; 

os«-4 chr; si*si44; ds * 4 chr; 



$ SET OMIT = NOT 



end; 
techcqflo * 

DL0CC03 «■ 

wqrdsleft <- 

end; 
if not present then 

BEGIN 
SHAREDISK 

REFLECTCHECKER; 
END ELSE 

resetparity; 
end writ; 
subroutine writeadjust; 

BEGIN 

T . I* 0; 
PCNUMWDS); 



o; 

numwds inx tip; 

wordsleft « numwds; 



%CJC 021 



% THIS ADJUSTS 8LQCK+REC PTRS 



END OF 



BCOUNT is 
RCOUNT I- a 

writ; 

BCOUNT 8* 
RCOUNT :* 
NUMWDS}.* I 
WORDSLEFT 
WRITEADJUST; 



*P(OUP) 
*PCDUP) 

*P(0UP> 
*PCDUP) 



i; 
i; 

i; 
i; 



SSAVE 
«BACK 
%WERE 



OFF NUMWDS 
UP BECAUSE 
READING 



WE 



«UP GRADE SO IT CAN STILL 
XTHINK THAT WERE READING 



»* *P(DUP)-NUMWDS;%DONT LOSE LAST REC 



02736800 


T 


02736900 


T 


02737000 


T 


02737100 


T 


02737200 


T 


02737300 


T 


02737400 


T 


02737500 


T 


02737600 


T 


02737650 


T 


02737700 


T 


02737800 


T 


02737900 


T 


02738000 


T 


02738100 


T 


02738200 


T 


02738300 


T 


02738400 


T 


02738500 


T 


02738600 


T 


02738700 


T 


02738800 


T 


02738900 


T 


02739000 


T 


02739100 


T 


02739200 


T 


02739300 


T 


02739400 


T 


02739500 


T 


02739600 


T 


02739700 


T 


02739800 


T 


02739900 


T 


02740000 


T 


02740100 


T 


02740200 


T 


02740300 


T 


02740400 


T 


02740500 


T 


02740510 


T 


02740519 


T 


02740530 


T 


02740540 


T 


02740550 


T 


02740600 


T 


02740700 


T 


02740800 


T 


02740900 


T 


02741000 


T 


02741100 


T 


02741200 


T 


0^741300 


T 


02741400 


T 


02741500 


T 


02741600 


T 


02741700 


T 


02741800 


T 



0388 » i 
0388*3 
0388*3 
0390*2 
0391*3 
0392»3 
0393*3 
0395*3 

0397*1 
0399*0 
0402*0 
0403»i 
0404*0 
0404*2 
0404*2 
0404*2 
0407*1 
0407*1 
0412*1 
0415*3 
0417*0 
0419*1 
0422*2 
0422*3 
0423*1 
0425*0 
0425*3 
0427*3 

0427*3 
0428*0 
0429*1 
0429*3 
0430*2 
0431*1 
0431*2 
0432*1 
0433*3 
0435*3 
0435*3 
0437*0 
0437*2 
0437*2 
0439*0 
0439*0 
0441*2 
0441*3 
0442*0 
0442*0 
0442*3 
0443*0 
0445*0 
0447*0 
0448*0 
0450*0 
0452*0 
0452*2 
0454*2 



I 
i 
I 

i 

i 
f 
i 
i 



• 



» * 



SUBROUTINE REED* 

BEGIN IP D 



% THIS READS A RECORD 
ISK THEN 
BEGIN LASTIO ♦■ 1* 
IF RCOUNT > TQTrEC 
BEGIN 
DLOCC 
WRITE 
IF OP 



OR BADKEY THEN 



03«- TjP &K27U7I1]; 
AFTEREOF ■* 3; 
ENlO AND SERIAL THEN 
RCOUNT * *P(DUP) +1* 



ERROR 

ENDJ 

DUQCC03* F 

RT *CBCOUN 

%RT = 

IF <T>(TxR 

CT >LSU 

BEGIN 

IF WR 



DtOCt 
ROTAT 
RT «■ 
END 
ELSE BEGIN 
PCeODE)* 
DISKADDRES 
CODE * p; 



LAGCFIBU62H 

T-t-cT«.(NUMBUF-l)))xSEGPERBLK; 

SEGMENTS READ »T*BUFFERS 
ECPERBLK)*RCOUnT) GTR TOTREC OR 
BU AnD BOUNDED) THEN 

IT8ACK THEN 
BEGIN 

writeadjust; 
go to iout; 

end; 

3 *T IP*1 t 27 *«7tl]&0t 2l*7li]J 

ebuf; %this flags error desc 
-i; % this inhibits prl 



code 
s; 



0} 



$ SET OMIT = NOT SHAREOISK 

ELSE 



END 



END 

IN 

NUMWDS<1 AND 

C [03 «- FLAG 



IQDON'E* 



IF C 
PREL 
WORD 



BEG 
IF 

DLO 

end; 

0DE*2 THEN NUMBUF *-2i 



RCOUNT >0 THEN 
(FIBC163); 



TERMC26); 



SLEF 



IF N 

BEGI 

$ SET OMIT * NOT SHArE 

END 
BEGI 
$ SET OMIT * NOT SHARE 

ENOJ 
IF R 

FIBC 
DLOC 
HARE 



OT 
N 

DISK 
ERR 
ELSE 
N RE 
DISK 



v IF DISK THEN % DISK HAS NO SHORT BLOCKS 
IF (BS*T0TREC-RC0UNT+2)£RECPERBLK THEN 
BUFFSlZE ELSE CBSxMAXREC) ELSE 
MEM CCNOT ) INX TIP3; 
PRESENT THEN 



or; 
setparity; 






$ SET OMIT = NOT S 
IOUTS END REED 
SUBROUTINE SEEK* 
BEGIN 



ANDOM THEN GO TO RAND0ML8L* 

16],C33I15] * TIP; 

CO]f (DISK) INX TIP & MAXR; 

DISK 



* 

% THIS CHECKS FOR PRESENTS OF BLOCKS IF NOT IT READS 



02741900 T 
027*2000 T 
02742100 T 
02742200 T 
027*2300 T 
027*2400 T 
02742*20 T 
02742450 T 
02742460 T 

02742500 T 
02742600 T 
027*2700 T 
02742800 T 
02742900 T 
027*3000 T 
027*3100 T 
027*3200 T 
027*3300 T 
027*3400 T 
027*3500 T 
027*3600 T 
02743700 T 
027*3800 T 
02743900 T 

027**000 T 
027*4100 T 
02744200 T 
0274*300 T 
027***00 T 
02744500 T 
027**599 T 
0274*800 T 
0274*900 T 
027*5000 T 
027*5100 T 
027*5200 T 
027*5300 T 
027*5400 T 
02745500 T 
02745600 T 
027*5700 T 
02745800 T 
027*5900 T 
02745905 T 
027*5909 T 
02745975 T 
02745980 T 
027*5985 T 
02745989 J 
027*5995 T 
027*6000 T 
02746100 T 
02746200 T 
027*62*9 T 
027*6300 T 
027*6400 T 
02746500 T 



0*54 J 3 

0455*0 

0*55«3 
0458*3 
0*61*1 
0*6l»3 
0463*3 
0*66*1 
0*69*0 

0471*2 
0473*0 

0*73*0 
0474*1 
0*78*3 
0*78*3 
0*82*1 
0*84*3 
0*85*1 
0486*1 
0*86*3 
0*88*0 
0488*2 
0*88*2 
0*91*2 
0*94' 1 
0*95*1 
0495*1 
0*95*3 
0*96*3 
0*98*0 
0*98*2 
0*98*2 
0498*2 
0*99*0 
0502*3 
0504*0 
0504*0 
0507*3 
0509*0 
0510*1 
0514*1 
0518*1 
0520*3 
0522*0 
0522*2 
0522*2 
0524*0 
0524*0 
0526*2 
0526*2 
0526*2 

0527*2 
0529*3 
0533*0 
0533*0 
0533*1 
0534*0 






m 
m 



m 



• 



REREADS 



$ SET OMIT = NOT SHAREDISK 



IF ((KEY «- KEY-1)<LSUBL ) OR (KEY >LSU8U AND BOUNDED) 
THEN 8ADKEY «■ TRUE 
ELSE BEGIN 

BCQUNT «• (RCOUNT*KEY) OIV NUMREC; 

IF BCOUNT * COUNT THEN 
BEGIN 

IF NUMBUFS2 THEN 
BEGIN 

R0TATE8UFJ 
IF NOT DONE THEN 



SEEKRTN: 



$ SET OMIT a SHAREDISK 



waitio; 

NUMBUF *i; 

DLOCC03 * dlocch; SCJC 018 

ENDI 
IF CQDE*2 THEN DLOCCH* TIP; 
IF RCQUNT $ TQTREC THEN REED 
ELSE IF 8C0UNT "(TOTREC DIV NUMREC) THEN 

BEGIN XABOVE CHECKS FOR LAST BLOCK 

RCOUNT * TOTREC; 

REED; 
END) 

rcount * key; 
if rtog then 

count * bcqunt «- *p(dup) - u 



END' 
$ POP OMIT 
$ SET OMIT = NOT SHAREDISK 

badkey * false) 
end; 

SEEKEY «- (CODEsS); 

IF CODE * 2 THEN P(XlT); 

END seek; 

%%%%%%%%%%%%% START HlnE%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
START J 

FIB * * (FLOC «• (NOT 2) INX OLOO* *SET UP IDS 
IF FPBCFNAM+3],[42i63«43 THEN % DUMMY 
IF CODE-0 THEN GO EOFSETCK ELSE 

IF PCMKSCW,TOP*XCH,DEL) THEN PCXlT) 

ELSE P(O'RTN); 
IOMA-SK I* '^2000.0000001 
IF (UNITYPE*UT)*4 THEN % DISK 
BEGIN 

H * * CFIBCU]]; % LOAD HEADER 
IF RCOUNT > LSUBU AND BOUNDED THEN 
IF CODE THEN 

IF (RC0UNT-(0PENI0 AND (SERIAL))) > LSUBU THEN 
P(1#RTN) ELSE ELSE BADKEY * TRUE; 
$ SET OMIT * NOT SHAREOISK 

IF CODE. till] THEN 

begin code«-abs(code)j 
$ set omit - not sharedisk 

end; 
end; 
if nqt(endprocess*q or code) then go to eofsetck; 



02746600 
02746700 
02746800 
02746900 
02747100 
02747200 
02747250 
02747300 
02747400 
02747500 

02747600 
02747609 

02747650 
02747700 
02747800 
02747900 
02748000 
02748100 
02748200 
02748300 
02748400 

02748500 
02748600 
02748700 
02748750 
02748800 
02748899 
02748900 
02748901 
02748909 
02749000 
02749100 
02749200 
02749300 
02749400 
02749500 

02749600 
02749700 
02749710 
02749720 
02749730 
02749740 
02749800 
02749900 
02750000 
02750100 
02750200 
02750300 
02750305 
02750310 
02750314 
02750325 
02750330 
02750334 
02750400 
02750450 
02750500 



0534 
0537 
0540 
0542 

0545 
0546 
0546 
0546 

0548 
0548 
0551 
0552 
0552 
0554 
0557 
0558 
0558 
0561 
0564 
0567 
0568 
0569 
0571 
0571 
0572 
0572 
0576 
0576 
0576 
0576 
0576 
0578 
0578 
0581 
0583 
0583 
0583 
0586 
0589 
0592 
0593 

0595 
0596 

0597 
0599 
0600 
0601 

0603 
0604 
0609 
0615 
0615 
0615 
0617 
0617 
0617 
0617 



* 
• 

• 
* 



• 

• 



• 



* SET OMIT ■ TIMESHARING 



IF" COOE>1 THEN 
BEGIN 

IF CDDE*2 THEN 
BEGIN 

IF HOWOPEN>1 
IF DISK THEN 



% OTHER THAN READ OR WRIT 
* SEEK- 



THEN GO 

seek; 



TO IMPROPER; 



IF 



$ SET QMIT = NOT SHAREDISK 



TERM(26); 
END' 
C0DE*6 THEN 
IF DISK THEN 



^IMPROPER SEEK 

% WRITE BLOCK 



XCUBE XIX I 



IF 



• 
* 



XIX 
XIX 
XIX 
XIX 
XIX 
XIX 
XIX 
XIX 

xix 

BLOCK 

XTR 857 
857 



QPENlO AND *CUBE 

FIB[4J, [27533 * 1 THEN %CUBE 

GO TO RANDOMIO %CUBE 

ELSE TE^Mf35) *CUBE 

ELSE % THEN IT IS TAPE %CU8E 

IF FlBC5] t [41U3 * THEN 3JCU8E 

% TERMC34) WHEN WRITE BLOCK ON INPUT OR ON XCU8E 

% REVERSED OR ON UNOPENED FILE, %CU8E 

TERMC34) ELSE %CU8E 

begin t :s wordsleft; swrite 
if t«buffsize then 

pcxit);%null blqckitr 
writ; 

rcount * *p(dup) - w 
P(xit); 
end write block; 
termc25); % un recognised code 
end; 
if cl-cqde) xhowopen then % check use vs how open 
improper! if howqpenm then term c31+code) else ^closed 

if not openio then termc proper ) i busage 

IF UNITYPE s lO OR UNiTYPE =13 THEN GO TO DATACOMj 
IF SERIAL THEN 
BEGIN 

T * WORDSLEFT -( NUMWDS^NUMWDS ) ; %COUNT WORDLEFT 
IF OPENIO THEN GO TO SERIALIO; 
IF CODE THEN * CODE*! ON WRITE 
BEGIN 

IF NUMWDS<1 THEN TERMC36); 
HASH; 

IF TECHC THEN 
BEGIN 

IF NUMWDS > 
T 4* 

IF T> MAXREC 

END 
ELSE IFCCOUNT * *P(OUP) " 1)>0 THEN 

OIDDLEREC ELSE WRIT; 
IF NOT DISK THEN 

pcxitj; 

IF (T«-RCOUNT-l) > TOTREC THEN TOTREC * T, 
PCO^RTN); 

END* 

aSCODEsO ON READ 
IF REVERSE THEN READREV ELSE 



MAXREC THEN 

WORDSLEFT- (NUMWDS*MAXREO; 
THEN DIDDLEREC ELSE WRIT; 



02750600 
02750700 
02750800 
02750900 
02751000 
02751100 
02751200 
02751400 
02751500 
02751600 
02751610 
0275161* 
02751620 
02751630 
02751640 
02751650 
02751660 
02751670 
02751680 
02751690 
02751700 
02751800 
02751830 
02751850 

02751900 
02752000 
02752100 
02752200 
02752300 
02752400 
02752500 
02752600 
02752700 
02752800 
02752900 
02753000 
02753100 
02753200 
02753300 
02753*00 
02753450 
02753500 
02753600 
02753700 
02753800 
02753900 

02754000 
02754100 
02754200 
02754300 
02754400 
02754500 
02754600 
02754700 
02754800 
02754900 
02755000 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0619*3 
0620*2 
0621J0 
0621J3 
0622*1 
062**1 
0627*0 
0627*0 
0628*1 
0628*1 
0629*0 
0630*1 
0630*1 
0631*3 
0633*2 
0633*2 
0635*2 
0635*2 
0637*2 
0637*2 
0637*2 
0639*1 
06*0*3 
06*2*1 

06*3*0 
06*4*0 

06*6*0 
06*6*1 
06*6*1 
06*7*2 
06*7*2 

0649*2 
0653*3 
0659*2 
0662*0 
0663*2 
0664*0 
0666*0 
0667*3 
0668*0 
0668*2 
0671*0 
0675S2 
0677*0 
0677*2 
0679*0 
0681*2 
0686*1 
0687*0 
0690*0 
0694*0 

0694*3 
0695*2 
0699*2 
0700*0 
0700*0 
0700*0 



THEN REED ELSE 
BADKEY THEN REED ELSE 
THEN GO TO EOFSETCK ELSE 



SSRANOCM AND 
RANDOMIO* 



else seek; 

AND CODE*05 



XCU8E XIX I 



THEN 



$ SET QMIT 



IF TECH * THEN REED ELSE %TR 899 

IF T < 1 OR 

if numwds<1 

diddlerec; 

hash; 

P <0#RTN) 

end; 
random 1-0 here on 

FIBU33. [44*13 «• 0; 
IF SEEKEY THEN KEY «-rCQUNT 
IF BADKEY OR (KEY > TOTREC 
BEGIN 

sanobkey * o; Preset seekey&badkey 

IF WRITBACK THEN ^RESTORE THE ADDRESS 
RCOUNT ♦ (C8C0UNT «- COUNT) x NUMREOI 
= NOT SHAREDISK 

pci*rtn>; 

eno; 
if seekey then 
begin if numbuf * 2 then 
begin rotatebuf; 

if not done then 



$ SET OMIT = NOT SHAREDISK 



end; 



waitio; 

NUMBUF *U 



* SET OMIT 



Randomlblj 



NOT 



'HEN 



seekey«-false; 
sharedisk 

rtdg*-random«.true; 

go to iodone; 
end; 
if invaliduser then 

BEGIN 

maybeparity; 
end; 

t ^random * false; 
if code * 6 then if writback 
begin p(bcount); 

WRIT* 
PCC8COUNT],*); 

RCOUNT #■ key; 
PCXIT); 
ELSE P(XlT); 
IF WRITBACK AND 
IF COUNT * 

BEGIN 

P(NUMW0S,8C0UNT); %LEAVE 

RCOUNT*- CBCOuNT*COUNT) * 

WRIT; 

P(CBCOUNT3,*);%PICK UP BLOCK COUNT 

NUMWdS «• p; 

RCOUNT <• key; 

END*' 

movrec; 

IF CODE THEN X IF RANDOM WRITE THEN WRITE 
BEGIN 
IF LASTIO THEN FIBC 133 , C 44 : 1 ] * U 



END 



CODE THEN 
BCOUNT THEN 



*CUBE 
XCUBE 
%CUBE 
XCUBE 
XCUBE 
XCUBE 
XCUBE 



block count 
numrec; 



XIX 
XIX 
XIX 

xix 

XIX 

xix 

XIX 



ON STK 



02755050 
02755100 
02755200 
02755300 
02755400 
02755500 
02755600 
02755700 
02755710 
02755800 
02755900 
02756000 
02756100 
02756110 
02756120 
02756129 

02756200 
02756300 

02756400 
02756500 
02756600 

02756700 
02756709 
02756795 
02756800 
02756900 
02756910 
02756919 
02757000 
02757200 
02757300 
02757400 
02757410 
02757430 
02757440 
02757500 
02757510 
02757520 
02757530 
02757540 
02757550 
02757560 
02757570 
02757600 
02757700 
02757800 
02757900 
02758000 
02758100 
02758200 
02758300 
02758400 
02758500 
02758600 
02758700 
02758800 
02758850 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 
T 
T 



0703»0 

0707»0 

071110 

0712*1 

071410 

0718*2 

0719*0 

0719*0 

0719*0 

0721*2 

0726*0 

0729*1 

0729*3 

0732*1 

0733*1 

0737*0 

0737*0 

0737*2 

0737*2 

0738*2 

0740*2 

0743*3 

0745*0 

0745*0 

0747*0 

0749*2 

0749*2 

0752*0 

0752*0 

0753*1 

0753*3 

0753*3 

0754*3 

0755*1 

0756*0 

0756*0 

0757*1 

0759*2 

0760*2 

0762*0 

0762*3 

0764*0 

0764*1 

0765*0 

0766*2 

0768*1 

0768*3 

0769*2 

0772*3 

0774*0 

0774*3 
0775*1 
0776*2 

0776*2 
0778*0 
0778*1 
0778*3 



» " 



* SET OMIT 



IF NOT (COUNT * BCOUNT AND 
BEGIN 

diskaddress;*compute 
COUNT ♦ bcount; 
end; 
totrec then tqtrec * key; 



WRITBACK) then 

NEW ADDRESS 



true; 



ROUTINES 
1-0 



MOD NUMREC); 



IF KEY 

mot sharedisk 

writback ♦ 
end; 
pco,rtn); 

%END OF MAIN LOGIC NEyT IS SPECIAL 
SERIALIO* XTHIS HANDLES SERIAL 

IF badkey then reed; 
if not clastnone and code) then 
if (count * *p(dup) -1) > then 
begin wordsleft «- t; 
GO TO didole; 

END ELSE 

BEGIN IF BOUNDED THEN 

IF RCOUNT = LSUBL THEN 

BEGIN COUNT * NUMREC - (8S «■ RCOUNT 

BCOUNT *• *P(DUP) - (BS t 0); 
END ELSE 

COUNT «• NUMREC ELSE 
COUNT «• NUMREC; 

IF CODE THEN % TWO WRITES IN A ROW 
BEGIN PCTlf INX 0); % LEAVES POINTER FOR MOVEREC 
IF RCOUNT GEQ TOTREC THEN 

BEGIN IF TECH ' AND WR I TEAFTEREOF ■ 2 THEN 
BEGIN WRITEAFTEREOF 4- i; 
RCUUNT ♦ *P(DUP) +2; 
BCOUNT * 

end; 

IF RCOUNT = 
BEGIN P(DEL); 

RCOUNT *• 

BCOUNT *■ 

WORDSLEFT * BUFFSIZE » NUMWDS; 

GO TO DIDOLEWRT; 
END ELSE 

writeadjust; 
else reed; 
«• 4; movrec; 
else reed; 



SCjC 022 



*P(DUP) +2; 



THEN 

*P(DUP) 
*P(DUP) 



+ i; 
+ 11 



CODE 



i; 



DIDDLEWRTJ 



DIDDLE 



END 

CODE 

END 

IF CODE THEN WRITBACK * TRUE; 

IF WRITEAFTEREOF =* 3 THEN WRITEAFTEREOF 

RCOuNT «■ *P(DUP) -i; 

movrec; 

rcount «- *p(oup) + 1* 
else go to diddlewrt/ 
lastdone «• not code; 

IF CT «■ RCQUnT -1) > TOTREC THEN 
IF CODE THEN TOTREC «• T % UPDATE 
ELSE GO TO EOFSETCK; % PASSED 
P(0#RTN); 
%END SERIAL 1-0 
DATACOM % ALL DATA COMM GOES THRU HERE 



2; 



END 



EOF 
EOF 



POINTER 
ON READ 



02758900 


T 


0782*3 


02758960 


T 


0785*2 


02759000 


T 


0786*0 


02759010 


T 


0787«0 


02759050 


T 


0788*2 


02759100 


T 


0788*2 


02759104 


T 


079111 


02759165 


T 


0791U 


02759200 


T 


0793*3 


02759300 


T 


0793*3 


02759400 


T 


0794*1 


02759500 


T 


0794*1 


02759550 


T 


079*11 


02759600 


T 


0797*0 


02759620 


T 


0798*3 


02759640 


T 


0801*3 


02759660 


T 


0803*2 


02759680 


T 


0804*0 


02759700 


T 


0804*0 


02759720 


T 


0805*2 


02759740 


T 


0807*1 


02759760 


T 


0811*1 


02759780 


T 


0813*3 


02759800 


T 


0813*3 


02759900 


T 


0815*3 


02759920 


T 


0817*3 


02759940 


T 


0818*0 


02759960 


T 


0819*2 


02759980 


T 


0820*3 


02760000 


T 


0824*2 


02760020 


T 


0827*2 


02760040 


T 


0829*2 


02760100 


T 


0831*2 


02760200 


T 


0831*2 


02760300 


T 


0832*2 


02760400 


T 


0833*1 


02760500 


T 


0835*1 


02760600 


T 


0837*1 


02760700 


T 


0839*3 


02760800 


T 


0840*1 


02760900 


T 


0840*1 


02761000 


T 


0842*0 


02761100 


T 


0844*0 


02761200 


T 


0846*3 


02761300 


T 


0848*0 


02761400 


T 


085U1 


02761500 


T 


0855*3 


02761600 


T 


0857*3 


02761700 


T 


0859*0 


02761800 


T 


0861*0 


02761900 


T 


0861*0 


02762000 


T 


0863*3 


02762100 


T 


0866*0 


02762200 


T 


0867*3 


02762300 


T 


0868*2 


02762400 


T 


0869*0 


02762500 


T 


0869*0 







* SET QMIT * NOTCTIMESHARING) 

IF NQT CODE THEN REMOTEREAD* REMOTEWRIT* 
$ POP OMIT 

$ SET QMIT = TIMESHARING 
EOFSETCKS IE ENOFILE THEN TERM (15); 

ENDFILE «- TRUE J 

PU*RTN)i 
% END OF EOF SET CHECK 

END OF COBOL I INTRINSICS* 



V&.W} 






tur 




PROCEDURE FBlNBACKBLOCK(FlLX*DKADOR»F'I*FMT#LISX»EOlTCOOE#EOFU#PARL) * 

START OF REL 
VALUE DKADDR*FI*LISX*EDITCaOE*EQFL*PARL * % INT # 9160, 
REAL DKADDR*Fl*LlSX*EDITCODE*EQFL*PARL* ARRAY FMT£*3i NAME FIIX } 
BEGIN 

INTEGER BSIZE, lSTRN=19 » 

REAL LISTYPE=20* ARRAYSTUFF* 18* ALGOLWR ITE» 12* ALGOLREAD* 1 3* T6* T7* 
SELECT*14* F0RTERRS2A* ARY* TYPE* D8LPREC*20* INDX*EQFL* 86700* 
OUT* FLG* IOINT* Tl* T2* T3* T 4* T5* TWDT* WH1«18* WH2*17* 
SIZEsPARL* INTINt=5* PRNTR* CKPBI* FMTWRDsCKPBI, FLB*FILX i 

name listaddr* addr * 

array ar1«listad0rc*3, fib[*3* i0buffco* tpar*23c*]* fpb«3e*3 * 

label alist* blkdta* sevens* endall* away* spcl.1' spcl2* dsz* 
cmpxl* du8el* logcl* strnl* intrel* bderr* endit* error* 
bo* bi» b01, bit* 8derr1* 8derr2* bi2* max* loop* strnl1* 
printer* outl* bkspc* b02* (303* b04* bio* bi3» bi4* bi5* endg* 

B6 * 

SWITCH TYP|_«-INTREL» STRNL* INTREL* LOGCL* DU8EL* CMPXL * 

DEFINE DONE = LSTRN=C-1) #* 

NOTDONE « LSTRN^(-l) »> 

—-KIND s FIB[43,[8S43 #* 

TAPEF = 2 #* 
REMOTEF * 13 #* 
DATACOMF * 10 #* 
INTEGR 9 1 #* 
STRING * 2 #* 
REEL * 3 #* 
LOGICAL * 4 #* 
OBLPRECSN s 5 #* 
COMPLEX = 6 #* 
TYPFF = [44:43 #, 
INDXF * [185153 #* 
SIZEF s [33U5] * ; 

__> SUBROUTINE BLANKIT i 
BEGIN 



02762600 


T 


086910 


02762700 


T 


0869*0 


02762750 


T 


0876*3 


02762800 


T 


0876*3 


02765800 


T 


0876»3 


02765900 


T 


0879*3 


02766000 


T 


0882*1 


02766100 


T 


0882*3 


02766200 


T 


0882*3 




SIZE* 0883 


02767050 


T 


0000*0 


SEGMENT) DISK 


ADDRESS * 


02767100 


T 


0000*0 


02767150 


T 


0000*0 


02767200 


T 


0000*0 


02767250 


T 


0000*0 


02767300 


T 


0000*0 


02767350 


T 


0000*0 


02767400 


T 


0000*0 


02767450 


T 


0000*0 


02767500 


T 


0000*0 


02767550 


T 


0000*0 


02767600 


T 


0000*0 


02767650 


T 


0000*0 


02767700 


T 


0000*0 


02767750 


T 


0000*0 


02767800 


T 


0000*0 


02767850 


T 


0000*0 


02767900 


T 


0000*0 


02767950 


T 


000010 


02767975 


T 


0000*0 


02767980 


T 


0000*0 


02768000 


T 


0000*0 


02768050 


T 


0000*0 


02768100 


T 


0000*0 


02768150 


T 


0000*0 


02768200 


T 


0000*0 


02768250 


T 


0000*0 


02768300 


T 


0000*0 


02768325 


T 


0000*0 


02768330 


T 


0000*0 


02768350 


T 


0000*0 


02768400 


T 


000050 


02768450 


T 


0000*0 


02768500 


T 


0000*0 


02768550 


T 


0000*0 


02768600 


T 


0000*0 


02768650 


T 


0000*0 


02768700 


T 


0000*0 


02768750 


T 


0000*0 


02768800 


T 


0000*0 


02768805 


T 


0000*0 


02768810 


T 


0001*0 



WORDS 



i 

• 
• 
• 

• 



00295 



# 



n 



• 
m 



a 



STREAM(C«-P(XCH)*A«-BSIZE-I*e<-PCDUP),C36 5 63«D*IQBUFF) ; 
BEGIN 

si«-loc a; 8csi*si-i; ds«.chrj; si*d; qs+a wds ; 
b(ds«-32wds; ds+32wds) ; 
end ; 
pcdel>del>ded ) 
— - end of blankit ; 

subroutine ckpb } 

BEGIN 

P(MKS,FLG)' If OUT THEN P ( DK AdDR, 0, ( •!) 3 ELSE P(CKPBI) I 

IF CBSlZE<-PCFILX,IGINT))<0 then go endit ; 

end of ckpb ; _, jtfjta*» lt 

i 



nw^ bff 



AW^- /J^,.^ Jt-t '-€., 



• 



-—-SUBROUTINE 10 ; * u -<*-~- r - • — •■ 

BEGIN PCO) i lM I ' J i ifl£-M> 

ENOALL* PCMKS,FLG,DKADPR>; IF OUT THEM P(Q*BSIZE); PCFILX* IOINT) '> 

IF P THEN 
ENDITI BEGIN FlLXtNOT 33*FILXCN0T 43*0; PCXJTJ END ) 

CKPB I 
^_, EN0 of 10 > 

- — —REAL SUBROUTINE NXTITM ; 
BEGIN 
PCIF TWDT THEN P(*[ARltlNDXt[33i73 J3#INDX AND 255*CDC3 

ELSE lARltlNDX]]) ; 
INDX*INDX + 1' NXTITM«.P J 
END OF NXTITM ; 

SUBROUTINE GETNEXTL I STI TEM ; 
BEGIN 

IF ARY THEN 
BEGIN 

auistj p(nxtitm) ; 

if dblprec then if out then wh2**nxtitm else in0x*indx+1 ; 
ary«-size>indx ; 

END 
ELSE IF TYPE-COMPLEX THEN 

BEGIN TYPE«"»CQMPLEX; PC t LI STADDRC 1 ] 3 ) END 
ELSE BEGIN 

P<ARRAYSTUFF*LlSTYPE*0)J LISTADDR«-CLISX 3 I 
DBLPREC ♦■(TYPE+'L I ST YPE.TYPEF) = DBLPRECSN I 
IF ARY«-ARRAYSTUFF*0 THEN 
BEGIN 

IF TYPEsCOMPLEX THEN TYRE*-CQMPLEX ; 
SIZE«-CINDX«-ARRAYSTUFF.INDXF)+ARRAYSTUFF,SIZEF I 
PcLlSTAOOR*MEMtLISTADOR,tl8U53 3) i 

twot+not p(lqo»top>; p(deu) '* 

if editcode*2 then go endg else go alist ; 

end ; 
pcdel*clistaddr[033) ; 

if oblprec then if out then wh2«-l i staddrc 1 3 '> 
end ; 
if out then wh1«-*p else addr«-p i 

ENDG? END OF GETNEXTLISTITEM i 
SUBROUTINE GETANDCHECK } 



\l^xi*(H&- 



02768815 
02768820 
02768825 
02768830 
02768835 
02768840 
02768845 
02768846 
02768850 
02768900 
02768950 
02769000 
02769050 
02769100 
02769700 

02769750 
02769800 
02769850 
02769900 
02769950 
02770000 
02770050 
02770JOO 
02770150 
02770200 
02770250 
02770300 
02770350 
02770400 
02770«50 
02770500 
02770550 
02770600 
02770650 
02770700 
02770750 
02770800 
02770850 
02770900 
02770950 
02771000 
02771050 
02771100 
02771150 
02771200 
02771250 
02771300 
02771350 

02771400 
02771500 
02771550 
02771600 
02771650 
02771700 
02771750 
02771800 
02772050 



T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



oooi 

0004 
0004 

0006 
0007 
0007 
0008 
0008 
0008 
0009 
0009 
0012 
0014 
0014 
0014 

0015 
0015 
0017 
0017 
0021 
0023 
0023 
0023 
0024 
0024 
0027 
0028 
0029 
0029 
0029 
0030 
0030 
0030 
0030 
0032 
0036 
0038 
0038 
0040 

0042 
0042 
0044 
0047 
0048 
0048 
0051 

0053 
0055 

0057 
0059 
0059 
0059 
0062 
0062 
0065 
0065 
0065 



« 



i 
f 



• 

• 

• 



BEGIN 

getnextlistitem; ti*ti-i ; 
if done then 

BDERR1* BEGIN P(l) ; 

BDERR* ll+Pt P<MKS#T1*TYPE#T2#FlQ#BSIZEii{-2}#F0RTERR} ) 
END i 
FtG*FLG+l ; 

END OF GETANDCHECK ; 

%*********************•**• l j CODE STARTS HERE J t ***********************#% 

LSTRN*CKPBl*l i 
IF EDITC0DE=6 THEN 
— -' BEGIN % 8L0CKDATA. 
BLKDTA: GETNEXTLISTITEM; P(CFMTWRD«-FMTtri*P + Fl3)"0) '> 

T2*FMTWRD.tl8li53J bS IZe* ( FMTWRD*0 ) +BS IZE i 

IF DONE THEN BEGIN IF NOT P THgN GO BDERRU P(XIT) END ; 

FLG*F|_G+1 > 

IF P THEN BEGIN PC2); GO BDERR END* T1*FMTWRD. [ 33U53*l J 

T3«-FMTCF'I«-FI + 13; T4«-FMT [FI + 1 3 ; 

GO TYPUT2-13 ' 
CMPXL* IF ABSCTYPE)*CQMPLEX THEN GO BDERR2; ADDRtO]<-T3 ; 

GETNEXTLISTITEM; ADDR CO 3 <-T4 J IF TlSO THEN GO SPCll ; 

GETANDCHECK ; 

GO CMPXL ; 
DUBEL? IF NOT DBLPREC THEN GO BDERR2; ADDR CO ]«-T3; ADDRU3*T4 * 

IF Tl LEQ THEN 
SPCLU BEGIN P(2); GO BLKDTA END I 

GETANDCHECK ; 

GO DUBEL ; 
LOGCL* IF TYPE^LOGICAL THEN 
BDERR?? BESIN P(3); GO BDERR END ; 

ADDRt03«-T3; IF Tl LEQ THEN r,0 SPCL2; GETANDCHECK ; 

GO LOGCL ; 
STRNLJ T4*FI; T3*T1+1I FMTWRO«-FMTWRD. [ 3* 15 ] } 
STRNL1J IF SBSCTYPEJsCOMPLEX OR DBLPREC THEN GO BDERR2 I 

ADDRC03<-FMTCFI3 J 

IF T1>0 THEN FI«-FI + 1 

ELSE BEGIN 

IF (FMTWRD«-FMTWRO»D$0 THEN GO SP-CL2J FI*T4; Ti*T3 * 

end ; 
getandcheck ; 

GO STRNL1 ' 
INTREL* IF ABS(TYPE) = COMPLEX THEN GO BDERR2; PC T3> t ADORE 3 3 ) ; 
IF TYpEslNTEGR OR TYPE*LQGICAL THEN 

BEGIN 

IF T3>PCMAX) THEN BEGIN P(4)J GO BDERR END ; 

P(ISD) ; 

END 
ELSE P(0 * 

if dblpREC then adorcu*o ; 

IF Tl LEQ THEN 

spcl2s begin p(l); go blkdta end ; 
getandcheck ; 

go intrel ; 

— - END OF 8LOCKDATA ; 
FIB*FILXCNOT 23; FILXCNOT 33<-PARL; FILX[NOT 43*EQFL ; 



02772100 
02772150 

02772200 
02772250 
02772425 
02772950 
02772975 
02773000 
02773050 

02773100 
02773150 
02773200 
02773250 
02773300 
02773400 
02773425 
02773450 
02773475 
02773500 
02773550 
02773600 
02773650 
02773700 
02773725 
02773750 
02773800 
02773850 
02773900 
02773950 
02774000 
02774050 
02774100 
02774150 
02774200 
02774220 
02774225 

02774230 
02774250 
02774275 
02774300 
02774325 
02774350 
02774375 
02774400 
02774410 
02774420 
02774430 
02774440 
02774450 

02774460 
02774470 

02774480 
02774500 
02774550 
02774600 
02774650 
02774700 



T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
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T 
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T 
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T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0066*0 
0066*0 

0068*1 
0069*1 
0070*0 

0072*3 
0072*3 

0074*0 
0074*1 
0074*1 
0074*1 
0074*1 
0081*2 
0082*1 
0082*3 
0086*1 
0089*1 
0091*2 
0092*3 
0095*3 
0099*1 
0103*3 
0106*0 
0109*0 
0110*0 
0110*2 
0113*2 
0114*1 
0115*2 
0117*0 
0117*2 
0118*1 
0119*2 
0123*0 
0123*2 
0126*3 
0129*0 
0130*0 
0131*2 
0133*0 
0136*3 
0136*3 
0138*0 
0138*2 
0140*2 

0142*1 
0142*3 
0144*3 
0145*0 
0145*0 
0145*3 
0148*0 
0148*3 
0150*0 

0151*0 
0151*2 

0151*2 










€ 



PCP.Cfl3»2]XTl*(EDITC0DE«5).+ 2**P(»ALG0LREA0)); 















PCFIB[5]5 J 

IF Fl<0 THEN GO OUTLJ 

FLG*OKADDR| GO DSZ ,' 

MAy:?J 97777777777777 i 

OUTLj_ - ™ ^ 

-~""~OUT«.i; P(P.U3UJ>*P<.ALG0LWRITE)J J 
IF FLG*DKAODR<0 THEN 

DKADDR<-0 ; 
I0INT*P; IF P THEN P( MKS*0# T 1 > FILX, 1 t SELECT ) * 
IF EDITC0DE=5 THEN 

/ ■ BEGIN % BACKSPACE. 

•IF FISC^D.CM *23/Q THEN GO ENDlT* C 
IF NOT CFIBCFLG+-03X1 AND KIND*TAPEF) 
IF «*(*[FILX])).C3I15]XP(SEVENS) THE 
IF C*(*tFILX]}), US*153*PCSEVEnS) TH 



DSZ 



BKSPC? 




KFBI*3J CKPB) 10 * 

THEN GO ENDU _j_ 
N BEGIN IO; _ GO BKSPC END * 
EN GO AWAY; GO ENDIT i 



end * 

T2«-CFIBC53 AND 
IF PRNTR*(T1-1 
THEN/BEGIN 



96)xo; ckpb; t4«-cti«-kind)=tapef; ckpbio j 

OR Tl»7 OR Tl=l2) AND FPBCF IBC4 3 , 1 13 : 1 1 3 +3 3 . [43 * 53<20 



IF BSIZE>17 THEN 
IF T2 THEN BEGIN 



BSIZE+17 ; 

iobuff«-tpar; 



PC" ")* BLANKTL-END J 



IF 






error 



U „ ft <¥^ 



V END " 

ELSE IF T2 AND T4 THEN F IBC 8 3 , [ 3 * 15 ]*0 ; 
IF FIB[03=0 THEN Fl8[03*-2* T5*T 1=*REM0TEF 
FIBC03X2 AND T4 THEN 
BEGIN Tl«-4 I 

p<mks»fibc6 3*filx,[33«15]»t1»fcirterr 
end ; 

T4 AND NOT FIB[ 133,124 113 THEN P(MKS#C 
T3*-p( SEVENS 5 * 

IF EDITCOOEsO THEN _____ 

BTgTn^CnTToRMAT^ NO LISTT} 
I0BUFF«-*FIL5r-r~" 
IF OUT THEN 
BEGIN 
IF PRNTR THEN 



IF 



OR TlsDATACOMF I 
-1)#F0RTERR) J 




PRINTER! 



0^ 



'A 

A: 





dup)+bsize ; 

.golwrite)* ckpb * 



i 



v v 



\/^ 



«* 







v- 



-BEGIN 
IF NOT T2 THEN F I B [ 17 3 **PC ! 
P(MKS,1,C*T2,BSIZE*FILX,AL< 

FlBCiZ3<-*PCDUP)-BSIZE ; 
STREAM(TPAR*8SIZE^S«-*FILX) 
/BEGIN 

(si«-tpar; ds«-bsize wds; di*tpar; iscds^slit" "> i 
\end * 
\go endit ; 

end i 
T5 then pc "j else pc»»o w ); 
t4 then iobuffco]*cnot 0)&cb: 
end 

ELSE IF T4 THEN GO 

P(1)J GO ENdaLL ; 

END i 
IF T4 THEN IF C *F RX ) ♦ [8 * 1Q 3 <3 THEN P( MKS, C-4 ), FORTERR ) * 
getnextlistitem; IF NOT OUT THEN GO BIO ; 
T1*T4J I0BUFF<-IF PRNTR THEN TPAR ELSE *FILX * 
IF T5 THEN BEGIN PC" "}J 8LANKIT END i 
B01IIF ARY THEN 



BLANKIT i 
ISIZE*1)C33*33*153 J 



AWAY 



BOJ 



BIO 



02774750 
02774800 
02774850 
02774900 
02774950 
02775000 
02775050 
02775100 
02775250 
02775300 
02775350 
02775400 
02775450 
02775500 
02775550 
02775650 
02775675 
02775700 
02775725 
02775727 
02775730 
02775735 
02775737 
02775740 
02775750 
02775800 
02775850 
02775900 
02775925 
02775950 
02776000 
02776050 
02776100 
02776150 
02776200 
02776205 
02776210 
02776220 
02776225 
02776230 
02776235 
02776240 
02776245 
02776250 
02776255 
02776280 
02776320 
02776550 
02776600 
02776650 
02776700 
02776750 
02776775 
02776800 
02776850 
02776875 
02776880 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
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T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0156S3 
0157*1 

0161»2 
0162*3 
0164*0 
016410 
0165*3 
0167*0 
0168*1 
0170*3 

0171*2 
0172S0 
0177*0 
0180*3 
0184*2 
0187*2 
0187*2 
0194*1 
0199*1 
0201*0 
0203*0 
0206*0 
0206*0 
0210*1 
0215*1 
0216*3 
0218*0 
0220*0 
0220*0 
0223*1 
0224*0 
0224*3 
0225*1 
0226*1 
0226*2 
0227*0 
0227*1 
0227*3 
0230*3 
0234*0 
0236*0 
0237*3 
0237*3 
0240*2 
0240*3 
0241*1 
0241*1 
0244*0 
0247*1 
0247* 1 
0248*3 
0249*2 
0249*2 
0253*1 
0254*3 
0258*1 
0260*0 



• 



DBLPREC*DUP)>SIZE-INDX THEN 



• 



• 

• 



BOSS BEGIN WHIM J 

IF K(BSIZE-Tl) AND NOT 
P(QEL,SIZE-INDX) ; 

IF TWDT THEN 
BEGIN 

IF PCDUP)>(WH2«-256-INDX.[40J8]) THEN 
BEGIN PC0EL*WH2); WHl*0 END ; 

P(*[AR1[INDX,C33!7 3 3 3,INDX.[40*83>CDC) * 
END 
ELSE PUAR1CINQX]]) ; 
WH2«-PCXCH) * 
STREAMCS*PlHH2»N*P(DUP)t[38l4],D*[IOBUFFCTl33) ; 

BEGIN SI*SJ DS+WH2 WDS* N(DS«-32WDS; DS*32WDS) 
P(DEL); T1*T1+WH2 ; 

IF ARY*CINDX*INDX + WH2XSIZE THEN IF WH1 THEN GO BQ4 
ELSE GO 603 * 
END * 
IOBuFFCT13«-fcHi; IF DBLPREC THEN I08UFF tTl*T 1+1 3*WH2 8 U + Tl + 1 
B03I6ETNEXTLISTITEM i 

IF NOT (DONE OR Tl+DBLPREC>8S IZE ) THEN GO B01 ; 
804*IF PRNTR THEN GO PRINTER; IF NOT T4 THEN GO AWAY ) 
PC(T1-1)4T3C3»33?153) { 

IF DONE THEN BEGIN PC SEVENS* CFX, C I0BUFFC03 1,*- >S GO AWAY END * 
Pai0BUFFCT3*-033*«O • 

ic* go bo ; 

SevenS:::P77777 
BIOUF T4 THEN 

BEGIN T74-BSIZE * 

IF T2 THEN Fib C 8 ] . [ 3 * 1] *B6700«- ( * ( * CF ILX3 ) ) . 1 1 » 13J»PC B6 ) 



END * 

ELSE GO B02 



THEN T6«-FIBE83. [4*143 ; 



AND T3) + n GO BIS END S 



Bit 



BI1 
BI2I 



AND T3)+i; PCT6+1) END ELSE PCO); 



THEN 



ELSE IF B6700«-FI6[83,C3:i3 
IF EDITCODE-O THEN 

BEGIN 8SIZE«-(I08UFFCT63 
END I 
I0BUFF+*FILX i 

if t4 then begin bs i ze* c iobuff c t6 ] 

ti+p ; 

:if ary then 

BEGIN WHIM i 

IF BCCBSIZ£+T6"T1) AND NOT DBLPREC*DUP }>SI ZE-I NDX 

PCDEL/SIZE-INDX) * 
IF TWOT THEN 
BEGIN 

IF P(DUP)>CWH2*256*lNDX,t40l83) THEN 
BEGIN PCDEL*WH2); WHj«-0 END * 

P(*CARltINOX.C33l73]3*INOXtC40l83#CDC) J 

END 
ELSE PCCAR1LINDX]]) J 

IF (WH2*P(XCH)) + CTYPE«-PCI0BUFF INX Tl ) )>HUNT( TYPE ) 
STREAM(S«-P«WH2*N«.PCDUP3.C38J4 3,TYPE) * 

BEGIN Sl*TYPE; DI*S* DS*Wh2 WDSS NCDS«-32WDS* DS*32WDS )END * 
PCDED; T1*T1+WH2 s 

IF ARY«-CINDX«-INDX + WH2)<SIZE THEN IF HH1 THEN GO BI4 ELSE GO BI2 
ELSE GO BI3 ; 
END * 
ADORt03«-lQBUFFCTl3; IF DBLPREC THEN ADDR tl 3*I08UFF[ T1*T 1 + 1 3 ; 

T1*T1*1 > 
BI35GETNEXTLISTITEM i 



THEN PCFLB); 



02776885 

02776890 

02776895 

02776900 

02776905 

02776910 

02776915 

02776920 

0g776925 

02776930 

02776935 

02776940 

02776945 

02776950 

02776955 

02776957 

02776960 

02776965 

02776970 

02777000 

02777050 

02777100 

02777150 

02777200 

02777250 

02777260 

02777265 

02777267 

02777270 

02777290 

02777292 

02777293 

02777295 

02777300 

02777302 

02777303 

02777305 

02777310 

02777315 

02777320 

02777325 

02777330 

02777335 

02777340 

02777345 
02777350 
02777355 
02777360 
02777365 
02777370 
02777375 
02777380 
02777385 
02777390 
02777395 
02777400 
02777425 



T 
T 

T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
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T 
T 
T 
T 
T 
T 
T 
T 
T 
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T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0260*1 
0261*2 
0264*1 
0265*3 
0266*0 
0266*2 
0268*3 
0270*2 
0272*3 
0272*3 
0273*3 
0274*2 
0276*3 
0279*0 
0280*2 
0283*2 
0284*2 
0284*2 
0290*0 
0291*0 
0294*0 
0295*3 
0297*2 
0300*3 

0302*0 
0303*2 
0305*0 
0305*1 
0306*2 
0309*3 
0315*3 
0316*2 
0319*2 
0319*2 
0320*2 
032413 
0325*1 
0325*2 
0326*3 
0330*0 
0331*2 
0331*3 

0332*1 
0334*2 

0336*1 
0338*2 
0338*2 
339*2 
0343*2 
0345*2 
0347*3 
0349*2 
0352*2 
0353*2 
0353*2 
0358*0 
0359*1 



i 

• 



• 



# 

m 



* m »■ 



f «■> » 



€ 



• 



IF NOT (DONE OR T 1+DBLPRECSBS I2E ) THEN GO BI1 ) 
BI4SIF NOT T4 THEN GO AWAY ; 
IF DONE THEN 
BEGIN 
815: IF B6700 THEN 
BEGIN 

IP BSIZe+T6<T7 THEN T6+T6+BS1ZE 
ELSE BEGIN 

WHILE NOT (*(T6 INX *FRX ) ) , C32 * 1 3 

DO BEGIN 10) T6*0 END ) 

IF CT6*((*(*[FILX3)) ANO T3)+1)£T7 THEN 

BEGIN 10) T6*0 END ) 
END ) 
FlBt8]»[4?H3*-T6) GO ENDlT ) 
END ) 
WHILE (*<*CFlLX3>).ri8U5J*T3 DO 10) GO AWAY ) 
B6! $ : P10000 ) 
END ) 
IF B6700 THEN 
BEGIN 

IF I0BUFFCT63.C32IU THEN BEGIn Tl*5) GO ERROR END ) 
IF BSIZE+T6>T7 THEN BEGIN 10) bSIZE'O END ) 
T6*BSIZE; GO BI ) 
END ) 
IF I0BUFFC0].C18*15]sT3 THEN BEGIN Tl*5) GO ERROR END ) 
10) GO BI ) 
END OF FBINBACKBLOCK ) 



02777450 
02777500 
02777550 
02777600 
02777650 

02777655 
02777660 
02777665 
02777670 
02777672 
02777675 
02777680 
02777685 
02777690 
02777695 
02777700 
02777725 
02777750 
02777755 
02777760 
02777765 
02777770 
02777775 
02777780 
02777800 
02777850 
02777950 



036 
036 
036 
036 
036 
036 
036 
036 
036 
037 
037 
037 
037 
037 
038 
038 
038 
039 
039 
039 
039 
039 
039 
039 
039 
040 
040 



SIZE* 



0*0 
3*0 

3*3 

4*3 

5*1 

5*2 

6*0 

8*0 
9*2 
1*1 
4*1 
7*0 
9*3 
9*3 
4*0 
4*0 
9*0 
0*0 
0*0 
0*1 
0*3 
3*2 
6*3 
8*0 
8*0 
1*2 
3*2 
4O4 



WORDS 



PROCEDURE FtINtF1X(FILX*DKADDR*FI*FMT*LISX*EDITC0DE*E0FL*PARL)) %INT?156 

START OF REL 
VALUE DKADDR*Fl*LlSX*EDITCODE*EOFL*PARL* ARRAY FMTE*H NAME FILX J 
REAL 0KADDR,FI,LISX,EDITCQDE>E0FL>PARL ) 
BEGIN 

INTEGER LSTRN*19* IT3 ) 

REAL LISTYP£*20* H0LTQG«2l* ARRAYSTuFF* 18* ALGOLREAD* 13* SELECTM«» 
F0RTERR=24* CHR* MAXCHR* FMTW* BUFF* TYPE* INDX* SIZE* TWDT* 
INTINT=5, SGN* NEEDNEWLISTADDRESS* SCALE* R* W* D> T3»IT3* T2* 
XTRA* D8LPREC* ARY* Tl* EXPsPARL* DECPT*EOFL* E*t8* WM1*17* 
SAVD* 

WH2«9, C*20* CODE* T4* COMMAS* DLRSGN* VL.* 0C10 ) 

NAME LISTADDR* ADDR ) 

ARRAY TENs22C*3* AR 1»L ISTADDR t* 3 * TpARs23C*3* F IB C* 3 ) 

LABEL ALIST* GETNEXTPHRASE* REPEAT* TT* XX* SS* PP* AA* 00* HH* 
CC* GG* LL* FF* EE* II* OD* ERR3* TEST1* AWAY* JJ* 
ERROR* BACK, GOTNUMBER* MAX* ENDALL* EDIT* BLANKS* ADJT* CHKC* 
FERROR* EX* ASK* ERR1* EX1* Oi* 02* El* E2* STNRO* OUTSuB* 
CD* NLEL* FQ94* F095* VERROR* HV* CD1 ) 



02 
SEGMENT 
02 
02 
02 
02 
02 
02 
02 
02 
02 

02 
02 
02 
02 
02 
02 
02 

02 
02 

02 
02 
02 
02 
02 



780000 
) DISK 
780050 
780100 

780150 
780200 
780250 
780300 
780350 
780400 
780450 

780500 
780540 
780550 
780600 
780650 
780700 
780750 
780800 
780850 
780900 
780950 
781000 
781005 
781050 



T 0000*0 
ADDRESS * 



§0309 



T 
T 
T 
T 
T 
T 

T 
T 
T 
C 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

ooooto 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 



ft 



SWITCH PHRASE + SS*HH>PP*XX*.TT'AA*00.»UL»JJtIlK66»FF-#EE#D0#CC I 

DEFINE DiNE = LSTRN*C"1) #, 
REEL - 3 ** 
LOGICAL * 4 #> 

INTEGR s 1 #> 
DBLPRECSN s 5 #, 

COMPLEX a 6 #* 

MAXCOOE = 15 #> 

VERRCVERR1) - BEGIN PCVERR1); 60 VERRQR 

ERR(ERRl) = BEGIN PCERR1); Go ERROR END 



H(Hl*h2>H3*H4) 



a IF Sci H >" THEN 
ELSE BEGIN 

IF SC«**#" THEN 



END #> 
n, 
HI? DS«-CHR 



RFA L 



TWOD * LISTYPE.C38U3 #, 
INDXF - C18 : 153 *, 
TYPEF = U4*4] #* 
SI2EF = C33U51 # > 

SUBROUTINE NEXTCHR ; 

BEGIN 

STREAMCC*0/BUFFIT*-T1«-T1*1) ; 

BEGIN DI*LQC BUFFj Dl*DI-i; 

buffer; nextchr*op i 

END OF NEXTCHR J 



.. -w- - .mw. H2*DS*LIT M *" ELSE 
IF SC*"&" THEN H3JDS*LIT"+ M ELSE 
IF SC* W %" THEN DS«-LIT M (" ELSE 
IF SC = w t M THEN DS«-LIT«)" ELSE 
IF SC«"(»" THEN H4lDS*LIT w "" ELSE 
IF ScX"s" THEN IF Sc* M <" THEN 
IF SC/">» THEN GO Hi ELSE GO Hg 
ELSE GO H3 ELSE GO H4 ; 
SI*SI+1 ; 
END #* 



si«-buff; ds«-chr; buff*si end 



SUBROUTINE RNDADJ *> 
BEGIN 

E«-CT4*PCXCH) + T2)+E; T2*-T2-T4J 
P(XCH*TENCT4W> f T4*lSN*XCH) ; 
END OF RNOADj ; 



T3*T3*T4I VL*l t 



SUBROUTINE CONVERT ; 
BEGIN 

STREAMCV«-0*Q>0*R«-O,C«-O,DECPT*N«.0,W*IF Tl>8 THEN 8 ELSE T1*BUFF# 
T<-0#J + C0DE*9*Z*T1<9) ; 
BEGIN 

SI«-BUFFJ DI*LOC T J 

WCL3* IF Sc>"0« THEN BEGIN TALLY*TALLY+1 * DS*CHR END 
ELSE IF SCa'V." THEN 
BEGIN 

ci*ci+decpt; go li; go l2* li» 
R«-tally; decpt«-tally; tally*qj 
CI*CI+Z; GO L3 ; 
END 
ELSE IF SC=" " THEN 
BEGIN 

ci*ci + j; go L2J tally*tally+i; DS«-CHR 



Q«-TALLY; TAtLY*lJ 

si*si+i ; 



02781100 
02781150 
02781200 
02781250 
02781300 
02781350 
02781400 
02781450 
02781455 
02781460 
02781500 
02781550 
02781600 
02781650 
02781700 
02781750 
02781800 
02781850 
02781900 
02781950 
02782000 
02782050 
02782100 
02782150 
02782200 
02782250 

02782300 
02782350 
02782400 
02782450 
02782500 
02782550 
02782600 
02782650 
02782700 

02782705 
02782710 
02782715 
02782720 
02782725 
02782730 
02782750 

02782800 
02782850 
02782900 
02782950 
02783000 
02783050 
02783100 
02783150 
02783200 
02783250 
02783275 
02783300 
02783350 
02783400 
02783450 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

000i*0 

0001*0 

0003*2 

0004*3 

0006*1 

0006*2 

0006*2 

0007*0 

0007*0 

0012*2 

0014*1 

0014*2 

0014*2 

0015*0 

0015*0 

0019*1 

0021*2 
0021*2 
0022*0 
0023*2 
0024*1 
0024*1 
0025*3 
0027*1 
0028*0 
0028*0 
0028*3 
0028*3 



« 



W i% 



t # * 



• 



ELSE 



L2* 



CVJ 



w«-si; 

end ; 

8UFF*-P; T3*p; 



Sli-LOC T 



END 

IF Sc="Q M THEN 
BEGIN 

ci*ci+J; go L2i oi*di+H si*si+i ; 

TALLY*TALLY+1 ; 
END 

else begin 

dialog oecpt; 
jump qut to cv 

END) } 

i di*loc v; n«-tally; 



DI«-DI"U DS*CHR ', 
* 

DS«-N OCT ; 



AND 



surr-r, u-r* DC 10«-< DECPT*P ) hivu 
Tl«-Tl-(CC«-PCXCH))*0)-PCXCH)-T3; T4 
IF COMMAS THEN IF C="#" AND NOT DCl 

run nr cnwwFDT : 



C0DE>10 J 
♦PJ PCXCH) 
THEN C*0 



END OF CONVERT * 

REAL SUBROUTINE DEBLANKDEZEROGETSGN ; 
BEGIN 

STREAM(O0»BUFF>VlM 

BEGIN SI*BUFF; 

TIC IF S C **» » TH 

IF SC>" 

ELSE IF 



LI* 



EL 



,SQN 
DI*T 
EN 

0" T 
SC* 
8EGI 
BUFF 
CI*C 
END 
SE I 
BEGI 
IF S 



*0»T2*0»T1 lT*Ti.C36»6 3»HADSGN«-S6N) I 

2 i 



L2J 



GO L 
END 
TALLY«-T 



si*si+i; ,n WVt ^ 

0I*T1I T2*TALLY I 
TC2C32CIF SCX" " T 
Trr SC> M 0" * rur 



IF 



L3! 



H 
THEN 
ELSE IF SC*"-" 
BEGI 
CI*C 
VL*T 
END 
ELSE IF S 
BEGI 
IF S 



L4S 



GO L 

END 

si*si+i; di* 



HEN 60 ENDS 

it-« jheN 

N 

♦•TALLY; TALLY*i; SGN*TALLY; TALLY*BUFFi 

i+hadsgn; go l2; hausgn«-di> vu*di t 

F Sc*"0" THEN 
N 

CXfi + w T HEN IF SCX W &" THEN 
BEGIN 

tally*tally+i* di*loc buff; di*di-i ; 
ds*chr; ends: T2*tally ; 

JUMP OUT TO ENDSJ J 
END J 

i ; 

ELSE VL*DI i 
ALLY+1) } 

EN 
BEGIN U*DU JUMP OUT 3 TO ENOSi END 
THEN 

n tallym1 sgn*tally i i 

i+hadsgn; go l4j tally*o; hadsgn*tallY; 

ally ; 

CX w O" THEN 

N 

CX"+" THEN IF SC^"«" THEN 

BEGIN 

DI*DI-BJ T1*DIJ DIALOG BUFF; DI*DI- J. , 

DS^CHR* JUMP OUT 3 TO ENDSl ; 

END ; 

3 ; 

else begin tally*0; vl*tally end j 
di*8)>) ; 



02783500 
02783550 
02783600 
02783650 
02783700 
02783750 
02783800 
02783850 
02783900 
02783950 
02784000 
02784050 
02784|00 
02784125 
02784150 
02784200 
02784250 
02784300 
02784350 
02784400 
02784450 
02784500 
02784550 
02784600 
02784650 
02784700 
02784750 
02784850 
02784900 
02784950 
02785000 
02785050 
02785100 
02785150 
02785200 
02785250 
02785300 
02785350 
02785400 
02785450 
02785500 
02785550 
02785600 
02785650 
02785700 
02785725 
02785750 
02785800 
02785850 
02785900 
02785950 
02786000 
02786050 
02786100 
02186150 
02786200 
02786250 



T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0030*0 
0030*0 

0030*3 

003083 
0032*0 
0032*1 
0032*1 
0032*2 
0033*1 
0033*3 
0034*0 
0035*2 
0035*3 
0038*3 
0042*3 
0046*1 
0046*2 
0046*2 
0047*0 
0047*0 
0050*1 
0050*3 
0051*3 
0052*2 
0053*1 
0053*1 
0054*3 
0056*0 
0056*0 

0056*3 
0056*3 
0057*3 
0057*3 
0058*2 
0059*0 
0059*2 
0059*2 
0059* 3 
0060*1 
0061*0 
006i*2 
0063*0 
0064*3 
0065*2 
0066*0 
0067*1 
0067*2 
0067*2 
0068*1 
0068*1 
0069*1 
0069*1 
0070*1 
0071*2 

00711-2 

0071*3 

0072*2 



m 



m 
m 



• 



ENOSl* 8UFF«-3I ; 

end * 

Tl*P(SU8#S3P); SQN^PJ VL*PJ 
0EBLANKDEZER06ETSGN«-(C*P)>9 * 
END OF DEBLANKDEZEROGETSGN ; 



BUFF*P ; 



• 
• 



SUBROUTINE CKPB I 
BEGIN 

MAXdHR*PCMKS,DKAODR>l»FlLX#ALGOLREAD)x8 t 
BUFF«-(PC*FILX)), [33*153 ; 
END OF CKPB J 



SUBROUTINE INPUT t 
BEGIN PCO) * 
ENOALL? PCMKS,DKADOR,CHR*o,FlLX*AL60LREA0) ; 
IF p THEN BEGIN FILXCNQT 33*FIlX[NOT 
CKPB * 
END OF INPUT ; 



43«-0* PCXIT) END * 



SUBROUTINE GETNEXTL I STADDRE 
BEGIN 

IF NEEPNEWUSTADDRESS 
BEGIN 

IF ARY THEN 
BEGIN 
ALIST: IF TWDT THEN 

ELSE PCCAR1C 
ARY«-CINOX*IN 
END 
ELSE IF TYPE^COMP 
BEGIN T 
ELSE BEGIN 

PCARRAYSTU 

DBLPREC*(T 

IF ARY*ARR 

BEGIN 

IF TY 

SIZE* 



ss ; 

THEN 



P(*UR1[INDX,C33S7133>INDX AND 255*CDC) 
INQX33J ; 
CX+1+DBLPREC) LSS SIZE J 

LEX THEN 

YPE*-COMPLEX> P(UISTADDRCin) END 



FF*0); LISTADDR«-CLISX3 * 
YPE«-LlSTYPE.TYPEF)*DBLPRECSN * 
AYSTUFF*0 THEN 

PE*COMPLEX then type«--cqmplex I 

CINDXfARRAYSTUFF»INDXF)+ 
ARRAYSTUFF,SIZEF ; 
TADDR*.MEM[LISTADDR»U8U533) * 
NOT P(LOD#TOP); PCDEL) * 
1ST i 



away: 



PCDE 
END 

NEEDNEWLISTADD 

END ■■; 

IF DONE OR EDITCODE 

BEGIN B(1)J GO 

END OF GETNEXTLISTA 



P(LIS 
TWDT*- 
GO Au 

end ; 

L*tLlSTADDR[033) 



ress+o; ADDR*P } 

si THEN 

ENDALL END * 
DDRESS ; 



SUBROUTINE NLE i 

BEGIN PCXCH); GETNEXTLISTADDRESSj 

IF WH2«-DBLPREC THEN WH2*ADDRCn * 
IF CWH1<-ADDR[03)+4>PCFQ94) THEN 

BEGIN IF Tl THEN VERR(P+10)* 



NEEDNEWLISTADDRESS*! 



P(DEL*F094) END 



ELSE IF PCDEL*C-PCF094)),DUP)<WHi THEN PCDEL#WH1) ; 



02786300 
02786350 
02786400 
02786425 
02786450 
02786500 
02786550 
02786600 
02786650 
02786700 
02786750 
02786800 

02786850 
02786900 
02786950 
02787000 
02787300 
02787350 
02787400 
02787450 
02787500 
02787550 
02787600 
02787650 
02787700 
02787750 
02787800 
02787850 
02787900 
02787950 
02788000 
02788050 
02788100 
02788150 
02788200 
02788250 
02788300 
02788350 
02788400 
02788450 
02788500 
02788550 
02788650 
02788700 

02788750 
02788800 
02788850 
02788900 
02788950 
02788955 
02788960 
02788965 
02788970 
02788975 
02788980 
02788985 
02788990 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0073 

0074 

0074 

0076 

0078 

0078 

0078 

0079 

0079 

008i 

0082 

0083 

0083 

0083 

0083 

0085 

0089 

0090 

0090 

0090 

009i 

0091 

0091 

0091 

0092 

0092 

0095 

0096 

0099 

0099 

0100 

0102 

0103 

0104 

0107 

0108 

0108 

0111 

0112 

0113 

0115 

0117 

0117 

0117 

Oil 

Oil 

Oil 

on 

01 
01 
01 
01 
01 
01 
01 




>i 







2 
2 
2 
1 
1 
2 
3 
1 
3 

1 
3 

1 
3 
3 
1 
3 
3 

8*1 
811 

9*2 
9*2 
1*2 
22*3 
23*0 
23*0 
23*0 
24*3 
27*2 
29*1 
32*0 



• 
• 






#■ 



a, it. • 







* n * 



» »* * 



* %> (f 



/*• 



• 



• 



PCXCH) * 

END OF NLE > 

SUBROUTINE HANDLEVARI ABLES ; 
BEGIN Tl*l * 
IF R=P(F095) THEN 

BEGIN P(O); NLE) T1*P(,R»ISN)>0; 0LRSGNtfl8ll5]*R ; 
IF C0DE=29 THEN 

BEGIN PCFI+W) > 

IF R£0 THEN P(CFMTCP]3,DUP*L0D*P&RE6?36»12]#XCH) 

ELSE P(.FI) % 

p(stn) ; 
outsub* p(oeu*deu); go getnextphrase i 

END > 

end ; 

IF T4«-COOEs30 THEN 

begin P(2); nlej pc,T2*isn) ; 

STREAM(pl«-P:P2<-P(CQ)*p3«-PCCDi)) > 

begin si«-ioc pi; si*si+7; di*loc P2* oi*di + i * 

32(IF SODC THEN JUMP OUT* TALLY*TAH..Y+l; SI*SI-1) } 
PUTALLY ; 

end ; 
if (t2 and 63)*t2 then p(del»32) ; 

IF (CQDE«-P + 3)>MAXC0DE AND Tl THEN VERRC2) ; 
T1«-CQDE>4 ANO Tl ; 

end ; 
Ta*Ti ; 

IF PCC0DE>U AND CQDE<14, FQ95 )«H THEN 
BEGIN PC ,W»4) ; 

nle; P(xch#iso); tupcduP) and T2*T2 and w>o ; 

end ; 
if d*p(fq95) then begin pc. 0,6)1 go nlel end i 
if cqde<4 then 

BEGIN IF T4 THEN W*RJ 

FMTW*FMTW4(P(0UP).C«H1] + (W<0))C«1I47-I13; GO HV J 
END ; 
IF NOT T2 THEN GO 0UTSU8; IF C0DE*5 THEN HVl'RM j 
IF P(DUP) AND D<0 THEN VERRC16) ; 
IF T4 THEN IF W S PCF094) THEN 

BEGIN IF C0DEX9 THEN VERRC6)* W*0 END 
ELSE IF P(DUP) AND 0=sP(F094) THEN 
BEGIN PC 7) ; 

T4«-Pj P<MKS#C00E#R#W#D»T4#WH1#HW2*FMTW# 
C-5)*F0RTERR) ; 

4094 I 

4095 ; 

P0047676321464341 ; % OPXTAOlJ 
^3127262524230000 ; % IGFEDCOO 

END * 
IF NOT P THEN SAV0**D*=0 ELSE SAVD*=D; 
END OF HANDLEVARIABLES ; 

SUBROUTINE ADJUST8UFF ; 

BUFF*CPC*FILX) INX T2 , t 33 * 12] HT2[ 30 * 45 I 3] ; 

SUBROUTINE SKIP I 

IF CTk-PCXCH}} GEO W THEN Tl«-W 



NLEL 



VERRORJ 

F094* * * 
F095: : * 

CD* * J 
CD1* * * 



02788995 


T 


0135!0 


02789000 


T 


0135* 1 


02789005 


T 


0135*2 


02789010 


T 


0135*2 


02789015 


T 


0136*0 


02789020 


T 


013653 


02789025 


T 


0137*2 


02789030 


T 


0141*3 


02789035 


T 


014212 


02789040 


T 


0143*3 


02789045 


T 


014710 


02789050 


T 


0147*3 


02789055 


T 


0148*0 


02789060 


T 


0149*0 


02789065 


T 


0149*0 


02789070 


T 


0149*0 


02789075 


T 


0150*1 


02789080 


T 


0152*2 


02789085 


T 


0153*3 


02789090 


T 


0154*3 


02789095 


T 


0156*3 


02789100 


T 


0157*0 


02789105 


T 


0157*1 


02789110 


T 


0159*2 


02789115 


T 


0162*3 


02789120 


T 


0164*2 


02789125 


T 


0164*2 


02789130 


T 


0165*1 


02789135 


T 


0167*3 


02789140 


T 


0168*3 


02789145 


T 


0173*1 


02789150 


T 


0173*1 


02789155 


T 


0175*2 


02789160 


T 


0176*1 


02789165 


T 


0178*1 


02789170 


T 


0182*0 


02789175 


T 


0182*0 


02789180 


T 


0184*3 


02789185 


T 


0187*1 


02789187 


T 


0188*3 


02789190 


T 


0192*0 


02789195 


T 


0193*3 


02789200 


T 


0194*2 


02789205 


T 


0197*1 


02789210 


T 


0198*0 


02789215 


T 


0199*0 


02789220 


T 


0200*0 


02789225 


T 


0201*0 


02789230 


T 


0202*0 


02789235 


P 


0202*0 


02789240 


T 


0205*1 


02789250 


T 


0205*2 


02789300 


T 


0205*2 


02789350 


T 


020610 


02789400 


T 


0209*1 


02789450 


T 


0209* 1 


02789500 


T 


0210*0 







ELSE BEGIN T2*CHR-Tlj ADJUSTBUfF END ; 
Z*****#************-******t I CODE STARTS HERE **************************% 



• 
• 



IF 
IF 
IF 

FERRCRJ 



FIB*FILXCNOT 23; FILXCNOT 33«-PARL* FILXCNQT 43*E0FL ) 
IF FI6C53, [43*23X2 THEN P (MKS,0, 2# FILX* \> SELECT ) ; CKP8 ; 

NOT(NOTCNEEDNEWLlSTADDRESS«-EOITcaDE»3) OR FMTCFI3)THEN GQ FERROR; 
FI8[03*0 THEN FIBC03M i 

(LSTRN«-1)XFIBC03 AND F IBC « 3 . C8 J 4 ] *2 THEN 
BEGIN T3*4 i 

P(MKS#FIBC7 3#FILX.C33U53#T3#F0RTERR) '> 
END > 
P(O) i 
GETNEXTpHRASE' 

R*PfFMTrn>FI + n*DUP>.[6il23J IF ( cODE*PCDUP ) . [ 1 853 }nZ THEN 
W« = P(DUP).ri8ll2]; SAVD«=05 s (FMTW*=P(DUP)) f [30* 12 3 J 
IF (XTHA*P(OUP) AMD 63), [44*23=0 THEN P(0#0) 

AND 15)*12*0UP) OR T4=8#P(XCHJ OR T4»4> i 



GO HH ; 



CFMTW AND 3)*0 THEN HANDLEVARI ABLES } 



ELSE PCPCCT4«-P(DUP) 
DLRSGN*-PS CQMMAS*P 
IF P, [42*13 THEN IF 
IF CODE=0 THEN 
BEGIN 

if d/0 then begin getnextl i staodress; input end 
if pcdup5.c19s153xfi then pc r&f i c 1 8 i 33 1 153 > ■ i 

if pcfnot 03*xch,inx,dup). [33*153*0 then p(del) 
go getnextphrase i 
end ; 

C0DE=5 THEN CHr«.q ; 



ELSE FI*FI»W i 



GO LL i 
AND CX"T") 

errcd ; 



IF 
REPEAT: 

IF C0DE>5 THEN BEGIN GETNEXTL ISTADDRESS; 
IF CODE/3 AND C0DEX9 THEN 

IF CCHR*-CHR + W)>MAXCHR THEN GO AWAY 
Tl*w; SGN«-H E*EXP<-DECPT*T2«-WH1 + Wh2«-0 
GO PHRASECCODE-13 I 
CHR«-W-1 } 

T2«-chr; adjustbuff; GO TESTl ; 
input; go testi ; 
if not cnextchrx" " or t1»0> then 
if not ccaddrcoj^cxt" and cx" ") 

P(V); IF CODEXH THEN PU2» + )J 
SCALE«-W«FMTWCU4lS13; GO TESTl f 

P(i6)i skip; pcdeblankdezerogetsgn); 

IF (T2«-C<8 OR C = m ") AND T1>0 THEN 

begin 
pcnextchr4pcxchh1uu4j) ; 

IF T2<-Tlsl5 AND C>3 THEN BEGIN PCDEDJ GO 

end ; 
if sgn then ptchs); addr[03«-p; if 

PC"n"); ERRC1+T2+T2) ; 

IF TYPE=L0GICAL THEN GO LL; IF TYPE'lNTEGR 

P("G M )J GO EDIT ; 

PC M E"); GO EDIT ; 

GO EDIT ; 

GO EDIT ; 

GO EDIT ; 



NEEDNEWLISTADORESS*-! END ; 



TT* 
XX* 
SSJ 

LL* 



PP: 
00* 
01 s 



THEN GO XX ; 



02 
GG 



IF T1=0 THEN SGN*SGN OR VL ; 

02 END ELSE GO 01 J 
T2 THEN GO TESTl ; 
THEN D*«=0; 



EE* 

FF* 
DD8 

in 



p("f m ); 
pco"); 
p < " i * > j 

PCJ") 



EDIT* 



02789550 
02789600 
02789650 
02789700 
02789750 
02789800 
02789850 
02789900 
02789950 
02790000 
02790050 
02790100 

02790150 

02790200 

02790250 

02790255 

02790260 

02790265 

02790270 

02790275 

02790300 

02790350 

02790400 

02790450 

02790500 

02790550 

02790600 

02790650 

02790750 

02790800 

02790850 

02790900 

02790950 

02791000 

02791050 

02791100 

02791150 

02791200 

02791250 

02791300 

02791350 

02791400 

02791450 

02791500 

02791550 

02791600 

02791650 

02791700 

02791750 

02791800 

02791825 

02791850 

02791900 

02791950 

02792000 

02792050 

02792100 



T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
P 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
C 
T 
T 
T 
T 
T 
T 



02U*3 
0215*1 
0215*1 
0215*1 
0215*1 
0228*3 
0233*0 
0235*2 
0238*2 
0241*3 
0243*0 
0245*0 

0245*0 

0245*1 

0245*1 

0249*3 

0253*3 

0257*0 

0261*3 

0262*3 

0267*0 

0267*3 

0268*1 

0272*0 

0274*3 

0279*2 

0280*0 

0280*0 

0282*0 

0282*0 

0284*3 

0286*2 

0289*1 

0294*0 

0303*0 

0304* | 

0306*2 

0308*2 

0312*0 

0315*3 

0318*2 

0320*3 

324*2 

0328*3 

0329*1 

0331*0 

0334*2 

0334*2 

0337*0 

0339*0 

0342*1 

0343*0 

0343*3 

0344*2 

0345*1 

0346*0 

0346*1 



t 

t 



• 



* .** 



# 






'9 






if deblankoezerqsetsgn then 

BEGIN 

IF DLRSGN THEN 

IF C= M S« THEN IF NOT DEBL ANKDEZEROGETSGN THEN GO E2 ) 
IF €005*9' THEN GO GOTNUMBER I 

if DECPT*-c* f v then 

BEGIN IF CODEslO THEN ERR(2)J PC C-Tl ) ) 1 
STREAM(8UFF#C*0»T2«-0*TllT*Tl i C36«63) ', 
BEGIN SI«-BUFF I 

tic if sc*"o* then if sc/ m * then if scx"q" then 

BEGIN 

IF SC<"0" THEN 

BEGIN 

OI«-LOC T2; Dl*DI-i; DS*CHR| TALLY*TALLY+1 J 

END ; 
JUMP OUT TO L ; 
END ; 
TAllY*TALLY + i; SUSl + 1) ; 

di*ti ; 

T(2C32CIF SC/"0 M THEN IF SC*" " THEN IF SC/"0" THEN 
BEGIN TUDI ; 
IF SC< H 0" THEN 

BEGIN DI*DI-8 * 

Tl*DIj DI*LOC T2J DI*DI-U DS*CHR t 

END ; 
JUMP OUT 3 TO I ; 
END ) 

di*di-8; si4-Si + i))) ; 

TUOI } 
LJ BUFF*Si; T2«-TALLY } 

ENO ; 
T1«-PCSU8*SSP)J c*p; 8uff*p; e*p+ti ; 
if c<io then if tl*0 then go gotnumber else go e2 j 
end ; 

IF C="*" THEN GO ASK; WH 1* 1-OECPT/ GO EXl i 
END 
ELSE IF T1*0 THEN BEGIN SGN«-VL OR SsNI GO GOTNUMBER END J 
E2* IF COOESIO THEN DECPT*i; VL*0 ; 
BACK* 

CONVERT ; 

IF T3"0 THEN IF COMMAS THEN GO CHKC ELSE P(DEL) 

ELSE BEGIN 

IF VL THEN 
BEGIN 

IF DCIO THEN PCT4) 
ELSE 
ADJT! PCT3> t 

E*E+PJ PCOEL) i 
END 
ELSE BEGIN 

IF DCIO THEN E«-E + T^*T3 ; 
IF CT2*T2+T3)>T3 THEN 
BEGIN 

IF T2<12 THEN GO STNRD ; 
IF DBLPREC THEN 
BEGIN 
IF P(DUP)=0 THEN IF T2>23 OR T1*0 OR C*0 THEN 



02792150 
02792200 
02792250 
02792300 
02792350 
02792355 
02792360 
02792365 
02792370 
02792375 
02792380 
02792385 
02792390 
02792395 
02792400 
02792405 
02792410 
02792415 
02792420 
02792425 
02792430 
02792435 
02792440 
02792445 
02792450 
02792455 
02792460 
02792465 
02792470 
02792475 
02792480 
02792485 
02792490 
02792495 
02792500 
02792505 
02792510 
02792550 
02792600 

02792650 
02792700 
02792750 
02792900 
02792905 
02792910 
02792915 
02792920 
02792925 
02792930 
02792950 
02793000 
02793050 
02793075 
02793100 
02793125 
02793130 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0346*1 

0347*0 

0347*2 

034713 

035l*2 

0352*3 

0354*0 

0357*0 

0359*2 

0359*3 

0361*3 

0361*3 

0362*1 

0362*1 

0363*1 

0363*1 

0363*3 

0363*3 

0364*2 

0364*3 

0367*1 

0367*2 

0368*0 

0368*1 

0369*1 

0369* 1 

0370? 1 

0370*1 

037i*2 

0371*3 

0372*1 

0372*2 

0375*2 

0378*2 

0378*2 

0381*2 

0381*2 

0385*0 

0387*3 

0387*3 

0389*0 

0391*2 

0392*0 

0392*1 

0392*3 

0393*2 

0393*3 

0394*2 

0395*3 

0395*3 

0396*1 

0398*3 

0400*2 

0401*0 

0402* 1 

0402*2 



• 
* 

• 



02793135 T 0403*0 






BEGIN VL*l; T2«-T2-T3; GO ADJT ENO i 
IF T2>23 THEN 

BEGIN 

PC(TEN[T2-T3-'l23xp(MAX)<WHl)-2^}| RNDADJ i 

END '* 
WH2«-P(0*XCH#WH2*WH1»0#TEN[T3]#0LM»DLA#XCH) I 

end 

ELSE BEGIN 

PCCTENET3-T2+12]XWH1>PCMAX))-12)J RNDADJ i 
STNRD* P(TENCT33xWHl,+) J 

ENO ; 
END ; 

WH1*P > 

end * 
chkc? if not cc*0 or t1<0) then go back / 

end ; 
if c>9 and c0dex9 then else go gotnljmber i 
exiuf not cc*"e" and c^'d") then go ex ; 

if c = " + " or c*"-" then begin pc t2,t 1 + 1 ) * skipj t2*p end 
elsf. if s*«?>" or holtog then go errl ; 

EX! IF cODEalO THEN ERRC2)* PCSGN); SGN*EXP*l I 
IF DEBLANKDEZEROGETSGN THEN 
BEGIN P(DEL) i 
ERR1S IF C = "*»' THEN GO GOTNUMBER* ErR( 1+C C0DE=10 AND C*"t M )> i 

end ; 
p(decpt)j decptmj convert/ if sgn then pcssn)) e*ct4*p)+e i 
decpt*pj sgn«-pj if c>9 then go errl j 

EH IF T1>0 THEN IF NEXTCHR>9 AnD C* m •» THEN GO ERRl ELSE GO El ) 

GOTNUMBeR! 

IF CODE>10 THEN 

BEGIN IF NOT DECPT THEN E«-E-D; IF NOT EXP THEN E«-E»SCALE END 
ELSE IF G0DE=9 THEN 

IF (CHR<-CHR + w-Tl-(C>9) + <C = C* M * , '))>MAXCHR THEN GO AWAY ; 
IF ABSCE)>44 THEN 

BEGIN IF E + T2>68 THEN GO ERR3; IF E<C-68) THEN E«"*68 END J 
IF DBUPREC THEN 
BEGIN 

PCWH2,WH1) i 
IF E/O THEN PCTENCABS(E)+693*TENtABSCE)]*IF E>0 THEN P(DLM) 

ELSE P(DLD)) / 
END 
ELSE BEGIN 

PCWH1}; IF E*0 THEN P CTEN I ABS CE ) 1> IF E>0 THEN PCx) ELSE PC/)); 
END ; 
IF SGN THEN PCSSN) ,* 

IF TYPEslNTEGR OR TYPEsLOGICAL THEN 
BEGIN 

IF P(DUP)>P<MAX) THEN BEGIN PCDEU* ERR3* ERR(3) END ) 
PCCADDRC013MSD); GO ASK ; 
END i 
PfCADDRt©]}.*-); IF OBLPREC THEN PC [ ADDRC 13 3> O i 
ASK,*P(DEDJ IF C/**" THEN GO TESTU GO XX ; 
MAX*** $0007777777777777 } 

HH: P(DEL)J IF CCHR«-CHR + R)>MAXCHR THEN GO AWAY * 
STREAM(BUFFlR»S*R,C36l63#HaLT0G#Q«-CFMT[FI J3) * 
RF C I N 

di*di + 3; si«-buff; ci*ci+holtog; go lu rchca,b,c*D)) ; 



02793140 
02793160 
02793165 
02793170 
02793175 
02793180 
02793185 
02793190 
02793195 
02793200 
02793205 
02793245 
02793250 
02793300 
02793350 
02793400 
02793450 
02793500 
02793510 
02793515 
02793550 
02793600 
02793650 
02793700 
02793750 
02793800 
02793850 
02793900 
02793950 
02794000 
02794050 
02794100 
02794150 
02794200 
02794250 
02794300 
02794350 
02794400 
02794450 
02794500 
02794550 
02794600 
02794650 
02794700 
02794750 

02794800 
02794850 
02794900 
02794950 
02795000 
02795350 
02795400 
02795410 
02795450 
02795460 
02795500 
02795550 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0407*0 
0410»0 

041013 
04 1 1 J I 
0415*0 
0415*0 
0418*0 
0418*0 
0418*2 
0423*0 
0424*1 
0424*1 
0424*1 
0424*3 
0424*3 

0427*0 
0427*0 
0429*1 
0431*2 
0436*2 
0439*0 
0442*2 
0444*0 
0444*3 
044R*3 
0448*3 
0453*2 
0455*3 
0460*2 
0460*2 
0461*1 
0466* 1 
0467*2 
0473*1 
0474*1 
0479*0 
0479*1 
0479*3 
0480*1 
0485*0 
0485*3 
0485*3 
0486*1 
0490*3 
0490*3 
0491*3 
0493*2 
0494*0 
0496*1 
0497*1 
0497*1 
0499*2 
050i »2 
0503*0 
0505*2 
0508*1 
0508*1 



#*»' 



,i$* 



4/ <*> •> 



**)- 



* -~™'C : tP > ' 



c 



• 
• 

• 



GO L2; LIS GG L3; L2S S C 2C 32(HC W#X, Y# Z ) ) ) ) ) GQ Ht L3* 

ds*r chr; s(ds«-32 chr; DS*32 CHR); L4* BUFF*SI ; 

END / 
FI<-Fl + (R + 2).[36;9}; BUFF*P; GO GETNEXTPHRASE ; 
cc * 

AAJ PC6); SKIP; ADDR[03«-IF PCC0DE*6,DuP) THEN P(BLANKS) else o ; 
STREAM(T<-IF P THEN 2 ELSE 8-T 1 8 BUFF, T 1* HOLTOG, ADDR ) } 

BEGIN 

DI*-DI + TJ SI«-BUFF; CK-CI+HOLTOGl GO LU Tl ( HC A#B*C*0 ) ) p 

GO L2| LIS QS*T1 CHR; L,2i T*SI ; 

end ; 
6uff«-p ; 

TESTIS 

if (r«.r-1)>0 then go repeat ; 

if cxtra and 3)*q then go getnextphrase ; 

pcxtRa); xtra«-w*o ; 

if p(dup) then begin w*p, [ 42 * 5] ; code*-*; go repeat end ; 

codem* r*p. [42*43*' go ss ; 

BLANKS: j (" " ; 
ERRORS 

pcfilxcnot 33)* fllx[not 3] *f ilx [not 43*0; p( mks* 9, intint ) ; 
T3«-pcded; t?«-p ; 
p(mks,t2»t3»w#savd#c00e#type#chr-t1*fibc73»buff#fmtcfi3*dlrsgn*c"3)# 

FORTERR) ; 
END OF FTINTFIX ; 



02795600 
02795650 
02795700 
02795750 
02795800 
02795850 
02795900 
02795950 
02796000 
02796050 
02796100 
02796150 
02796200 
02796250 
02796300 
02796350 
02796400 
02796450 
02796500 
02796700 
02796750 
0^796800 
02796850 
02796900 
02797450 



T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
T 
T 
SI2 



0521S0 

0534S1 
0536«1 

0536S2 
0541 JO 
054180 
0545S0 
0548S3 

0548S3 
056l$3 
056?*3 
0563S0 

0563*2 
0563*2 
0566*1 
0568*0 
0569»2 
0574*0 
0578*0 
0579*0 
0579*0 
0584*1 
0585*2 
0590*0 
0590*1 
t- 0591 



WORDS 



PROCEDURE FTINT > 



COMMENT 



REAL 



ARRAY 
NAME 

INTEGER 
REAL 



BEGIN 
FILX 
FMTA 
LISX 
EDITCODE 



PARL ; 

EOFL 
FORTERR s 

EDITCODE 

LISX 

FI 

DKADR : 

READINT 

SELECT ' 

FMTA .-? 

FILX » 

MEM ! 
LSTRN 
LISTYPE 



'ILE 
"OR MA 
^CCID 



1 

2 

3 

4 

5 
6 

: M 

: »2 

' 24' 

-4 
• 6 

■■ 13 
: 14 

' -5 
: -8 

> 2 



% 050 



TOP 10 DESCRIPTOR 
T OR NAMELIST OR 
ENTAL ENTRY DESc. OR 

NO FORMAT. NO LIST 

FORMAT* NO LIST 

NO FORMAT, LIST 

format* list 
namelist 
backspace 
blockdata; 

* 
p 



c*3; 



19; 

20* 



02800000 

START OF REL SEGMENT; DISK 

02800100 
02800200 
02800300 
02800400 
02800500 
02800600 
02800700 
02800800 
02800900 

02801000 
02801100 

02801200 
02801300 
02801301 
02801400 
02801500 
02801600 
02801700 
02801900 
02802000 
02802100 
02802160 
02802190 
02802300 
02802400 



T 0000*0 
ADDRESS m 



00329 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000050 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



# 



ARRAY 

NAME 
REAL 



NAME 
ARRAY 

INTEGER 



BOOLEAN 



DEFINE 



LOGV 
INTEG 
STRGV 
DBLV 
CMPLX 
NyM 
GTYPE 
FTYPE 
ETYPE 
DTYPE 
ITYPE 
LTYPE 
ATYPE 
OTYPE 
KIND 



ARRAYSTUFF 

HOLTOG 

TEN 

fipc*i; 

LISTADRi 

BUFF 

BSIZE 

NBC* 

NFCI> 

DHi* 

WH1 

WH2.J 

wi; 

IOBUFF 

RPT> 
W 

BDTYP 

WT 

Tl 

D 

DT 

Dl 

02 

CNT* 

EXP 

EXPSGN* 

CODE 

SKP 

NCR 

LCR 

CHR 

PRCW 

PCT* 

PS 

DONETOG 

SGN 

FRTOG, 

LGTG* 

DTAERR, 

FMERRTOG 

GTQG* 

ctog; 

« 4#, 
V *1#> 
*2#t 



* 1 8 p- 

* 21) 

■ 22t*l» 



% FIRST BUFFER POSITION 
% ARGUMENTS 



■ BUFFC*3; 



= Wi 



* % FIELD 



> % 

* % 
, % 

* % 
, % 

* % 



DEC- 



WIDTH 



IMAL P- 
LA- 
CE' 



* % EXPONENT 



PAREN 
PAREN 



f % 

, % 

p % 

, % 

, % 
CONTROL 
COUNTER 



EDITING FUNCTION 
REDUNDANT POSITIONS 
CURRENT BUFFER POSITION 
BUFFER SIZE IN CHARACTERS 
CURRENT CHAR FROM FORMAT 
WORD 



% 



SCALE FACTOR 
RETURN AFTER 
SIGN 



WRITE 



% TRUE IF NUM HAS FRACTION PART 



* % FORMAT ERROR 



V 



= 2#. 



5#> 
6*, 

2#, 
3#* 
4#, 
5»» 
6#, 
7U, 
8#, 
■ CFIBC43 • C8 



<n)*> 



02802500 
02802600 
02803900 
02803000 
02803100 
02803200 
02803300 
02803400 
02803600 

02803700 

02803800 

02803900 

02804100 

02804200 

02804300 

02804400 

02804500 

02804600 

02804700 

02804800 

02804900 

02805000 

02805100 

02805200 

02805300 

02805400 

02805500 

02805600 

02805700 

02805800 

02805900 

02805910 

02805920 

02806000 

02806100 

02806200 

02806210 

02806300 

02806400 

02806500 

02806700 

02806800 

02806900 

02807000 

02807100 

02807300 

02807400 

02807600 
02807800 

02807900 
02808000 
02808100 
02808200 
02808300 
02808400 
02808500 
02808600 



T 
T 

T 

T 

T 
T 

T 
T 
T 

T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 
0000*0 
0000*0 
0000?0 
0000«0 
0000*0 
0000*0 

0000:0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

OOOOJO 

0000*0 

OOOOJO 

0000*0 

0000*0 

OOOOJO 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
OOOOJO 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



i 

i 



• 
# 



H- )» 



*p» 



*> 



• 



* i"*» 



c 



LABEL 



COMME 
SU8RO 
BEGIN 
LCR «■ 
BUFF 
END C 
SUBRO 
BEGIN 
P(MKS 
IF DO 
$ SE 

IF KI 
I 

$ SE 

ckpb; 

END R 
LABEL 
REAL 
BEGIN 
NFCLi 
WHILE 
STREA 
BE 



TAPEF *2#, 
MAX » $7777777777777$, 
ELMTYP s LISTYPE , C<U!43#, 
DLN - (LISTYPE, [44:43 * DBLV)#» 

CMPLX ■■ (LISTYPE, [4*143 = t*MPLXV)#, 
TWOD * LISTYPE, C38«ll#* 
LPPS ■ 15J30:18#, 
LPPR = Cl5*183#* 
RPTF s C33»153## 
N'ORF = (P(XCH»DUP) < 0)#> 
PCF » C9:6]#, 
ENDLIST - (LSTRN = (-D)## 
SIZEF = [33*153#* 
BASEF = C18»15]#i 

TYPERR* FMCYc, FMERR* MON# FNOL' FMTLST* FRMTCD* NFPH* 
STRT*REPEAT#LPAR#RTPAR*SLASH,STRING,TFMT,FMTERR* 
CLl»CL2*CL3#CL«»SCAL#H0L»SKIP#CL3A#STRA#TFMA#TIX# 
G# F>E>DC*I>L>A>0,COMM, 
LLfLLi; 
MT ***** START OF SUBROUTINE DECLARATIONS ******** 
UTINE ckpb; 
COMMENT INITIALIZE FILE AND ACQUIRE RECORD SIZE; 
8x(BSIIE * PCMKS>DKADR>l>FlLX#READlNT)); 

* (*filx).c33: 15]; ncr * 0# 

kpb; 

utine reads; 

,dkadr/0#filx»readint); 
netog then p(xit); 

T OMIT s MOT(TIMESHARING) 

NOXIO THEN %%% THEN NOT FROM DATA COM. 

F NOT (<*FILX>.C19S13) THEN P( FILX, ®20000O0000# 36>C0M*0EL*DEL )i 

T OMIT a TIMESHARING 



eads; 
nfcl; 
subroutine 



nfc; 



N 

MC 
GI 



FCI. C45I33 < 2 DO NFCI *■ NFCI + U 

PI <* OJP2 <-FMTA[NFCI,[30*1533>P3 «- NFC 1 , [ 45 I 33 ) ; 



N 



BEGIN 



DI 
SI 

SI 

IF 
I 

IF 

IF 

IF 



♦■ loc pi; 
«- loc p2; 



* SI 

sc < 

sc ■ 
sc « 
sc - 



DS * 

SI +si 

- ii DI ♦ DI 

"A" THEN 



7 LIT «o«; 

+ P3;ds * chr; 






THEN 
THEN 
THEN 



DS 
DS 
DS 



* LIT *' H " 

* LIT ")" 
*LIT "(♦*; 



ELSE 
ELSE 



E 
EN 
NFCI 
NFC <• 
END N 
SUBRC 
BEGIN 



ND 

o; 

«■ 

c 
fc; 
utine put; 



NFCI + 

:hr; 



l; IF (CHR * P) * » « THEN IF NOT LGTG THEN GO NFCL; 



WHILE NFCI. [45133 <2 DO NFCI * NFCI + i; 



02808800 
02809000 
02809100 
02809200 
02809300 
02809400 
02809500 
02809600 
02809700 
02809800 
02809810 
02809900 
02810000 
02810100 
02810300 
02810400 
02810500 
0281Q600 
02810900 
02811000 
0281U00 
02811200 
02811300 
02811400 
02811500 
02811600 
02811700 
02811800 
02811900 
02811909 
02811910 
02811920 
02811950 
02812200 
02812300 
02812400 
02812500 
02812600 
02812700 
02812800 
02812900 
02813000 
02813100 

02813200 
02813300 
02813400 
02813500 
02813600 
02813700 
02813800 
02813900 
02814000 
02814100 
02814200 
02814300 
02814400 
02814500 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
000080 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000i:o 
000i:0 
0003*3 
0006*0 

0006*1 
0007*0 
0007*0 
0008*1 
0009*1 
0009*1 
0010*3 
001412 
0014*2 
0016*0 
0018*0 
0018*0 
0018*0 
0018*0 
0018*0 

002H2 
0024*1 
0025*3 
0026*3 
0027*1 
0027*3 
0027*3 
0029*0 
0030* 1 
0031*1 
003H1 
003i«2 
0035*0 
0035*2 
0035*3 
0036*0 
0036*0 



c 

# 

STREAM(P2«-CFMTA[NFCl,[30ll5333>P3«-NFCI.C45J33#P«*NBC)* 02814600 T 0039*2 

_ BEGIN 02814700 T 004210 

• 51 ♦ LOC P4; SI*SI+1I 02814800 T 0042*0 

01 *• P2; DUDI + P3; DS«-CHR; 02814900 T 0042*2 

END; 02815000 J 0043*2 

• NFCI <• NFCI +i; 02815100 T 0043*3 

END PUT; 02815200 T 00^5*0 

SUBROUTINE GET; 02815300 T 0045*1 

• BEGIN? 02815400 T 0046*0 

STREAMCP1 <-CNBC]!P2 «• BUFF); 01815500 T 0046*0 

_ BEGIN 02815600 T 0047*1 

• SI * P2; DI *■ Pi; 02115700 T 0047*1 

01 «■ OI + li OS <• CHR; 02815800 T 0047*3 

PI ♦ Si; 02815900 T 0048*1 

• END; 02816000 T 0048*2 

BUFF «■ P; 02816100 T 0048*3 

IF HOlTOG THEN 02816200 T 0049*1 

• BEGIN 02816300 T 0049*2 

IF (NBC «• NBC, [6*63) = "#" THEN NBC *• "« M ELSE 02816400 T 0050*0 

IF NBC * "&" THEN NBC * "♦" ELSE 02816500 T 0053*0 

• IF NBC « "%« THEN NBC *- «(" ELSE 02816600 T 0055*2 

IF NBC = "[•» THEN NBC ♦ ")" ELSE 02816700 T 0058*0 

IF NBC = "P" THEN NBC >'"»"; 02816800 T 0060*2 

• N8C «■ Q&NBC[6*42*63J 02816900 T 0063*0 

END; 02817000 T 0064*3 

A END GET; 02817100 T 0064*3 

m % PARAMETERS FOR LIST CONTROL 02817200 T 0065*0 

BOOLEAN ATOG»TWDT; 02817300 T 0065*0 

ARRAY AR1 « LISTADR[*3; 02817400 T 0065*0 

• INTEGER INDX* SIZe; 02817600 T 0065*0 

LABEL RTNLST^SRT; 02817700 T 0065*0 

DEFINE NXTELM * IF TWDT THEN P ( * CAR 1 [ INDX , [ 33 5 73 3 3 * INDX , [40 ? 83 * CDC) 02817800 T 0065*0 

• ELSE [AR1[IN0X3]#; 02817900 T 0065*0 

SUBROUTINE GETLIST1 02818000 T 0065*0 

BEGIN 02818100 T 0065*0 

% SRTt IF ATOG THEN 02818200 T 0065*0 

BEfilN 02818300 T 0065*1 

Ml «■ NXTELM! 02818400 T 0065*3 

INDX «- INDX + DLN; 02818500 T 0070 ' 1 

IF (INDX MNDX + 1> * SIZE THEN 02818600 T 0072*2 

BEGIN 02818700 T 0074*1 

ARRAYSTUFF * o; 02818800 T 0074*3 

ATOG * FALSE; 02818900 T 0075*2 

END; 02819000 T 0076*1 

GO TO RTNLST; 02819100 T 0076*1 

END; 02819200 T 0076*3 

IF CTQG THEN 02819300 T 0076*3 

BEGIN % IMAGINARY PART OF COMPLEX 02819400 T 0077*0 

Wl <• [LISTADRC133* 02819500 T 0077*2 

CTOG «• FALSE; 02819600 T 0078*3 

GO TO RTNLST; 02819700 T 0079*2 

END; 02819800 T 0080*0 

P(0); 02819900 T 0080*0 

LISTADR ♦ [IISX3; 02820000 T 0080*1 

IF ARRAYSTUFF * THEN 02820100 T 0081*0 

BEGIN 02820200 T 008t*3 

ATOG * TRUE; 02820300 j 0082*1 



E^n; 



RTNL 
END 

SUBRGUTI 

BEGIN 

STRT 



TWDT«-NGT PC*(LISTADR«-MEM[LISTADR.C18I15]])*T0P); 
SIZE*(INDX<-ARRAYSTUFF,BASEF}+ARRAYSTUFF,SIZEF ; 
GO TO SRTJ 

Wl ,*■ CLISTAORC033J 

pcded; 

ctog * cmplx; 

ST J 

GETLISTJ 

NE FORMATCGNTROL; 



P(DEL) i 






CLl J 



W*D<-CQDE«-SKP*RPT*OJ 
SGN<-DONETOG«-FMERRTOG«"FALSri 
COMMENT CHECK FOR SINGLE CHARACTER 
NFC<9 THEN GO TO REPEAT' % 
CHR="(" THEN GO LPAR; 
THEN 
THEN 
THEN 

THEN 
SGN«-CCHr 3 «-«) & CCHR»" + «)[2i47ii]; 

IF SGN THEN 
BEGIN 

if nfc<9 then go to repeat 
else go to fmterr* 
end; 



IF 
IF 
IF 
IF 
IF 
TF 



EDITING TYPES; 

MUST BE REPEAT FIELD 



CHR=")" 
CHR = 'V" 
CHRs ,,n " 
CHRs«T" 



GO 
GO 

GO 
GO 



rtpar; 
slash; 
string; 
to tfmt; 



• 

• 

m 



TF CHR: 

rpt«-i; 



! M . « 



»" THEN GO TO STRt; 



to fmterr; 



CL2! COMMENT TYPES WHICH MAY HAVE REPEAT FIELOS; 
IF SGN THEN RPT«"*RPt; 
IF CHR»"P" THEN GO TO SCAl; 
IF RPT<0 OR SQN,C2»13 THEN GO 
IF CHR-«C" THEN GO TO LPAR; 
IF CHRa«H w THEN GO TO HOL; 
IF RPT«0 THEN RPT*i; 
IF CHR a "X" THEN GO TO S«IP; 
CL31 COMMENT TYPES WHICH HAVE w FIElOSJ 

IF CHRb«i»» THEN CODE *■ ITYPE ELSF 
IF CHR = "A" THEN CODE <• ATYPE ELSE 
IF CHR*"l" THEN CODE * LTYPE ELSE 
IF CHR*"0" THEN CODE * OTYPE; 
IF CODE > ITYPE THEN GO TO CL3A; 
CL«: COMMENT TYPES WITH W AND D FIELDS; 

IF CHRs«D" THEN CODE * DTyPE ELSE 
IF CHR*»E" THEN CODE «■ ETYPE ELSE 

if chrs"f" then code * ftype else 
if chr* n g" then code * gtype else 
go to fmterr; 
cl3aj comment develop value of w field; 
if nfc>9 then go to fmterr; 
w*chr; 
while nfc<9 do w«-10xw + chr; % convert to octal 

NFCI«-NFCI»i; 

IF W>63 THEN GO TO FMTERR; 
IF C0DE2ITYPE THEN GO TIX; 
COMMENT DEVELOP D FIELD; 



02820400 T 
02020700 T 
02820800 T 
02820900 T 
02821000 T 
02821100 T 
02821200 T 
02821300 T 
02821400 T 
02821500 T 
02821600 T 
02821700 T 
02821800 T 
02821900 T 
02822000 T 
02822100 T 
02822200 T 
02822300 T 
02822400 T 
02822500 T 
02822600 T 
02822690 T 
02822700 T 
02822800 T 
02822900 T 
02823000 T 
02823100 T 
02823200 T 
02823300 T 
02823400 T 
02823500 T 
02823600 T 
02823700 T 
02823800 T 
02823900 T 
02824000 T 
02824100 T 
02824200 T 
02824300 T 
02824400 T 
02824500 T 
02824600 T 
02824700 T 
02824800 T 
02824900 T 
02825000 T 
02825100 T 
02825200 T 
02825300 T 
02825400 T 
02825500 T 
02825600 T 
02825700 T 
02825800 T 
02825900 T 
02826000 T 
02826100 T 



008350 
0086*2 
0089*1 
0089*3 
0089*3 
0090*2 
0090*3 
0092*2 
0092*2 

0092' 3 
0093*0 
0093*0 
0093*0 
0095*3 
0097*2 
0097*2 
0100*0 
0101*1 
0102*2 
0103*3 
0105*0 
0106*1 
0109*0 
0109*1 
0109*3 
0111*2 

0112*2 
0112*2 
0113*3 
0114*2 
0114*2 
0116*1 
0117*2 

0120*0 
0121*1 
0122*2 
0124*2 
0125*3 
0125*3 
0127*3 
0130*1 
0132*3 
0135*1 
0136*2 
0136*2 
0138*2 
014H0 
0143*2 
0146*0 
0146*0 
0146*0 
0148*0 
0148*3 
0153*1 
0154*2 
0155*3 
0157*0 






LPARS 



IF NFC*"," THEN GO TO FMTERRJ 

IF NFC>9 THEN GO TO FMTERR; 

D*-CHRi 

WHILE NFC<9 DO D*10xD+CHR; % CONVERT 

NFCI*NFCI-i; 

GO TO tix; 

COMMENT GENER1TE PAREN CONTROL WORD; 
IF PCT*0 AND RPT*0 THEN RpT*l ; 
Tl «• RPT«NFCHLPPS3&(RPTS0)C1U7I1]; 



TO OCTAL 



• 



IF PCT < 1 THEN PRCW * Tl 

pctijxch); pct * pct + 1; 
go to strt; 
rtpar? comment point at left par 
if norf then 
begin % no repeat field 

DONETOG «• ENOLIST ; 

reads; 

if cpct «• pct " 1 ) < then if 
then begin pc xch>prcw } ; pct * 

END ELSE 
BEGIN 

if crpt*p<dup),rptf) < 1 
then begin pcded'pct * 
else p(rpt - 1,ccx)j 

end; 



& PCTC9U2I63I 



IF REPEAT NOT EXAUSTED; 



PRCW,PCF *0 

2 END ELSE PCT 



1; 



PCT * 1J GO TO STRT END 



NFCI<-PCDUP)»LPPR; * RESET TO LEFT PAREN 
PCXCH)* 

go to strt; 
repeat? comment convert repeat field to octal in rpt; 

RPT*-CHRJ 

WHILE NFCS9 DO RPT* lOxRPT+CHR; 

GO TO CL2; 

slash! % read next record 

reads;. 

go to strt; 
strings % move string from buffer to format 

lgtg * true; 

get; put; ncr «■ ncr + 1; 
stra! if nfc = h,, « then begin lstg «■ false; go to strt end; 

if (ncr «• ncr ♦ u > lcr then go to fmterr; 

get; nfci ♦ nfci-i; 

put; 

go to stra; 
tfmt: comment set buffer to charactfr position indicated by field 

following "t m ; 

if (rpt«-nfc)>9 

while nfc<9 do 

if rpt*lcr then 

NCR>RPT-i; 

tfma» buff <■ c(*filx) 

go to strt; 
scal« comment scale factor 

ps*rpt; 

go to strt; 
h0l! comment hollerith string; 

while rpt > do 

BEGIN 



then go to fmterr; 
rpt«-io*rpt+cmr; 
GO TO fmtfRr; 



INX NCRtC33«123)&NCRC30U5i3JJ 

of p phrase; 



02826200 


T 


0157*0 


02826300 


T 


0159J0 


02826400 


T 


016i:o 


02826500 


T 


0161 ; 3 


02826600 


T 


0166«1 


02826700 


T 


0167*2 


02826800 


T 


0168*0 


02826810 


T 


0168*0 


02826900 


T 


0171*0 


02826910 


T 


0174*1 


02826920 


T 


0177*1 


02827000 


T 


0179*0 


02827100 


T 


0179*2 


02827200 


T 


0179*2 


02827300 


T 


0180*2 


02827400 


T 


0181*0 


02127500 


T 


0182*2 


02827510 


T 


0184*0 


02827520 


T 


0187*0 


02827600 


T 


0190*2 


02827700 


T 


0190*2 


02827800 


T 


0191*0 


02827900 


T 


0192*1 


02828000 


T 


0195*1 


02828100 


T 


0196*3 


02828200 


T 


0196*3 


02828300 


T 


0198*0 


02828400 


T 


0198*1 


02828500 


T 


0198*3 


02828600 


T 


0198*3 


02828700 


T 


0199*2 


02828800 


T 


0204*1 


02828900 


T 


0204*3 


02829000 


T 


0204*3 


02829100 


T 


0206*0 


02829200 


T 


0206*2 


02829300 


T 


0206*2 


02829400 


T 


0207*1 


02829500 


T 


0210*1 


02829600 


T 


0213*1 


02829700 


T 


0215*2 


02829800 


T 


0218*1 


02829900 


T 


0219*0 


02830000 


T 


0219*2 


02830100 


T 


0219*2 


02830200 


T 


0219*2 


02830300 


T 


0222*2 


02830400 


T 


0227*1 


02830500 


T 


0228*2 


02830600 


T 


0229*3 


02830700 


T 


0232*3 


02830800 


T 


0233*1 


02830900 


T 


0233*1 


02831000 


T 


0234*0 


02831100 


T 


0234*2 


02831200 


T 


0234*2 


02831300 


T 


0235*3 



I 

i 
i 
i 



c 



• 



• 
• 






if (ncr * ncr + 1) > l.cr then go to fmterr; 

get; put; 

rpt«-rpt-i; 

end; 

go to strt; 
skip* comment x phrase; 

if (ncr «- ncr + rpt) > lcr then go to fmterr; 

go to tfma; 
fmterrs. fmerrtog«-true; 

TIX! 

end fcrmatcontrol; 

subroutine skpc; x skips current characters, puts next characters 
begin; % IN NBC 

STREAM (PI ♦•BUFF >P2*0 ? P3*Q ) ; 

BEGIN 

si <- pi; si «- si + 1; pi «- si; 

oi <- log Pa; di ♦ D1+7; ds ♦ chr; 

eno; 

nbc *■ p; buff *■ p; 

WT * WT -i; 
END SKPC; 
SUBROUTINE SCALE; 
BEGIN 

IF (Dl ♦ 01 + CNT) > 11 
THEN 00UBLE(WHl*WH2*TENCCNTl*TENC69+CNT3^x* 

DHl,0,+,<-#WHl»WH2) 
ELSE WH1* WHlxTENECNT3+DHi; 
DH1 ♦• O; 

end scale; 
subroutine getnum; 
begin; 

stream(p1«-buff*p2«-1f wt < 8 then wt else 8, p3«-q, p4*0 j p5*0 },* 

BEGIN 

Sl<-Pi; DIALOG P5 ; 
P2(IF SC<"0« THEN 

IF SC*" «♦ THEN 

IF SCs"0 M THEN BEGIN DS*LIT W 0"J SI*SI+i;GO L ENO 
ELSE JUMP OUT ; 
DS*CHR ; 
Ll TALLY*TALLY+1) ; 

p2*tally; pi*si ; 
si*loc p5; di*loc r3; ds«-p2 oct ; 
sr*-Pi ; 

di «■ lOc P4; pi *• 01 + 7; ds «■ chr; 
end; 

nbc «■ p; dhi «• p; cnt *■ p; buff * p; 
end getnum; 
subroutine getsign; 
begin; 

stream(p1«-8uff*p2«-(if wt > 63 then 63 else wt > * p 3*0* p4* (- 1 ) * 

P5«-Q); 

BEGIN 

SI«.P1I Dl<-P2 ; 

P2(DI*DI-8; IF Sc*" " THEN JUMP OUT TO LI* 
SI * SI ♦ i; TALLY * TALLY + 1); 
PI * SI; 

go to rtnsgn; 



02831400 
02831500 
02831600 

02831700 
02831800 
02831900 
02832000 
02832100 
02832200 
02832300 
02832400 
02832500 
02832600 
02832700 
02832800 
02832900 
02833000 
02833100 
02833200 
02833300 
02833400 
02833500 
02B33600 
02833700 
02833800 
02833900 
02834000 
02834100 
02834200 
02834300 
02834400 
02834500 
02834600 
02834700 
02834800 
02834900 
02835000 
02835100 
02835200 
02835300 
02835400 
02835500 
02835600 
02835700 
02835800 
02835900 
02836000 
02836100 
02836200 
02836300 
02836310 
02836400 
02836500 
02836600 
02836700 
02836800 
02836900 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0235 
0238 
0240 
0241 
0241 

0242 
0242 
0244 
0245 
0245 
0245 
0246 
0246 
0246 
0247 
0247 
0248 
0249 
0249 
0250 
0251 
0251 
0252 
0252 
0253 
0256 
0258 
026i 

0261 
0262 
0262 
0262 
0266 
0266 
0266 
0267 
0268 
0269 
0270 
0270 
0271 
0271 
0272 
0272 
0273 
0273 
0275 
0276 
0276 
0276 

0279 

0280 

0280 

0280 

0282 

0283U 

028312 



• 



n 



LI J IF SC * H 0" THEN 
BEGIN 

L3s P2 «■ tally; 

L2* P5(Pl*Dp TALLY*P2J PI C IF SC/ M " THEN 

jump out; tally*tally + i; si*sim>j p2*tally); pi+si ; 
di * loc P4; os ♦ 7 lit "o«j os *, chr; 
go to rtnsgn; 

end; 

IF SC ■ »," then go to L3; 
TALLY ♦ TALLY+i; 

P2 * tally; 

TALLY*i; P5«-TALLY I 

IF SC»"-" THEN TALLY«-1 ELSE IF SC»"+" THEN TALLY*0 ELSE 

IF SC="&" THEN TALLY«-0 ELSE 

BEGIN TALLY«-0; PH-TALL*; GO TO RTNSGN END; 

P3 <- tally; 
si * si + i; 

GO TO L2; 

rtnsgn* 

end; 

nbop; sgn«-p; cnt*p; otaerr*c(buff*p>*0) t 

end getsign; 

LABEL NCRTN#BLSGN; 
SUBROUTINE NUMCONVERT; 
BEGIN 

DH1 ♦ Di ♦ 02 * EXP * EXPSGN * FRTOG *Q; 

WHi ♦ WH2 «• "0; 

wt *■ w; 
blSgns 

getsign; 

if dtaerr then go to ncrtn ; 

wt ♦ wt - cnt; if nbc <0 % blank field 

then if wt i then go to ncrtn else go to blsgn; 
if nbc s 9 then 

BEGIN 

getnum; WHI * 0H11 

IF (WT * WT - CDi * CNT)) S THEN GO TO NCRTN; 

WHILE NBCS9 OR NBC*" " OR NBCo«Q« DO 
BEGIN 

getnum; scale; 

if cwt * wt*cnt) < then go to ncrtn; 
end; 
end; 



BEGIN 



BEGIN 



end; 
end; 



IF NBC * "." THEN 
I 
FRTOG «- TRUE; 

Skpc; 

IF WTSO THEN GO TO NCRTN ; 

WHILE N8C<9 OR NBC* M " OR N8C*"0 M DO 

I 

getnum; scale; 
d2 *• d2 ♦ cnt; 
if ( wt * wt - cnt) < then go to ncrtnj 



IF NBC = "D" OR NBC * M E" THEN SKPC; 

IF WTSO THEN BEGIN DT AERR<-TRUE; GO TO NCRTN END ; 



02837000 
02837100 
02837200 
02837300 
02837310 
02837400 
02837500 
02837600 
02837700 
02837800 
02837900 
02838000 
02838010 
02838020 
02838025 
02838100 
02838200 
02838300 
02838400 
02838500 
02838600 
02838700 
02838800 
02838900 
02839000 
02839100 
02839200 
02839300 
02839310 
02839400 
02839405 
02839500 
02839510 

02839600 
02839700 
02839800 
02839900 
02840000 
02840100 
02840200 
02840300 
02840400 
02840500 
02840600 
02840/00 
02840800 
02840900 
02840910 
02841000 
02841100 
02841200 
02841300 
02841400 
02841500 

02841600 
02841700 
02841710 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 



0283*3 
0284*1 
0284*1 
0284*2 
0287*0 
0289*0 
0290*3 
0291*0 
0291*0 
0291*3 
029?*0 
0292*1 
0292*3 
0294*3 
0295*3 
0296*2 
0296*3 
0297*0 
0297*1 
0297*1 
0297*2 
0300*2 
0300*3 
0300*3 
0301*0 
0301*0 
0304*1 
0305*3 
0306*2 
0306*2 
0308*0 
0309*0 
0310*3 

0313*1 
0314*0 
0314*2 
0316*3 
0319*2 
0322*3 
0322*3 
0325*0 
0327*1 
0327*3 
0327*3 

0328*2 
0329*0 
0329*3 
0331*0 
0332*1 
0335*2 

0335*2 
0338*0 

0339*1 
0341*2 

0342*0 
0342*0 

0345*0 






• 






• 



• 



IF CNBC***") 
THEN SKPC; 
IF WT$0 THEN 
IF NBC > "9" 
ELSE 



OR CNBC* M &") OR (NBC« M *' ) OR (EXPSGN* ( NBC*"-" ) ) 

BEGIN DTAERR*TRUEJ GO TO NCRTN END i 
THEN DTAERR * TRUf 



BEGIN 



getnum; 

exp * if expsgn then c-dh1) else dh1j 

if cwt*wt*cnt) $ then go to ncrtni 



WHILE WT > 

end; 
ncRtNi 

IF WH1 = 
END NUMCONVERT^* 
SUBROUTINE CONVERT; 
BEGIN 

WH1 «• 

GO TO 

GO 

GO 

GO 



DO SKPCI 



THEN IF SGN THEN WH1 «* *0; 



A* 



IF 



WH2 *• o; WT +W; 

P(CODE,DUP#ADD); 

FMERR' 

g; go to f; go to 
l; go to a; go to 
% octal conversion 
w>16 then skp*w-wt<-16 



TO 
TO 
TO 



e; 
o; 



GO TO DC; GO TO U 



ELSE SKP*0 ; 

STRgAM(Pl*BUFF>P2+0*P3*CWHl]*PA*SKP»P5*WT*P6«-16*WT#P7*0* 
P8«-CWT = 16)3 ; 
BEG I N 

si*pi> pi*tally; tally*i ; 

P4(IF Sc = " » THEN Sl«-SI + l ELSE IF SC« M 0" THEN S I «• S I -f 1 

else begin p7cjump out 2 to mast); ip sca""" then 
p2*tally else if 5c*"+ m then if sc* m &" then jump out 
to mast; p7*tally; si*si+i end) ; 

p8cif sc>"3 m then jump out to mast) ; 

di*p3; p6cskip 3 db) ; 

go to fast; mast* go to last; fast? 

p5cif sc>"0" then if sc<"8" then begin 



TALLY; 3CIF SB THEN DS*SET ELSE 



SKIP 3 

ds*reset; 

IF SCX" M 



OUT TO LAST ELSE BEGIN 
THEN BEGIN P7CJUMP OUT 2 TO LAST); 
P2*TALLY ELSE IF Sc* w + M THEN 

jump out to last; p7*tally end 

3 DB END) ; 



THEN GO TO COMM ; 



THEN 
THEN 

SKIP 



ELSE JUMP 
IF SC*"0" 
IF Sew"-" 
IF SC/"& M 

si*si-h; 
pi*si ; 
last? 

eno ; 
s6n*pj if <dtaerr*c(buff*p)«0)) 

whohif sgn then -wh1 else whl ; 

go to comm; 

% alpha conversion 

if w > 6 then skp * w - (wt «• 6); 

wHi «■ M M ; 

STREAM (Pi* BUFF5P2«-CWH13,P3«-SKP>P4*WT#P5«-H0LTQG); 
BEGIN 

SI * Pi; 

DI «■ P2; 

p5(P*C 

IF SC i "A" 

IF SC * "#" 



sb; 

SKIP 
THEN 



P7* 

SB) 



END 



SI 
DI 



SI 
DI 



P3; 
2; 



THEN 
THEN 



DS «• CHR 
BEGIN SI 



ELSE 
«• SI 



*i; DS ■«• LIT "*» END ELSE 



02841800 


T 


0347*2 


02841900 


T 


0351*0 


02841910 


T 


0353*0 


02842000 


T 


0355*2 


02842100 


T 


0357*0 


02842200 


T 


0357*2 


02842300 


T 


0358*0 


02842400 


T 


0359*0' 


02842500 


T 


0361*2 


02842600 


T 


0363*3 


02842700 


T 


0366*2 


Q2842800 


T 


0366*2 


02842900 


T 


0366*2 


02843000 


T 


0369*2 


02843100 


T 


0369*3 


02843200 


T 


0370*0 


02843300 


T 


0370*0 


02843400 


T 


0372*0 


02843500 


T 


0373*0 


02843600 


T 


0373*2 


02843700 


T 


0376*0 


02843800 


T 


0377*2 


02843900 


T 


0377*2 


02843950 


T 


381*3 


02844000 


T 


0384*2 


02844050 


T 


0385*2, 


02844100 


T 


385*2 


02844150 


T 


0386*1 


02844200 


T 


0388*1 


02844250 


T 


0390*3 


02844300 


T 


0392*1 


02844350 


T 


0393*2 


02844400 


T 


0395*1 


02844410 


T 


0396*2 


02844450 


T 


0397*0 


02844500 


T 


0398*3 


02844550 


T 


0401 JO 


02844600 


T 


0402*2 


02844650 


T 


0404*2 


02844700 


T 


0406*0 


02844750 


T 


0407*1 


02844800 


T 


0408*0 


02844850 


T 


0408*1 


02844900 


T 


0408*1 


02844950 


T 


0408*2 


02844975 


T 


0411*1 


Q2845000 


T 


0413*3 


02845100 


T 


0414*1 


02845200 


T 


0414*1 


02845300 


T 


0417*1 


02845400 


T 


0418*0 


02845500 


T 


0420*0 


02845600 


T 


0420*0 


02845700 


T 


0420*3 


02845800 


T 


042!*! 


02845900 


T 


0422*1 


02846000 


T 


0423*1 



c 

If 







Lt 



I! 



E* 

Ft 
6* 



m 

• 
• 



IF 

IF 

IF 

IF 

OS «• 

JUMP 

OS <• 



SC 
SC 
SC 
SC 



* " S " 

* »%" 

8 «[« 

e n e " 
CHRJ ); 
OUT TO 
P4 CHRi 

SI; 



THEN 
THEN 
THEN 
THEN 

xn; 



BEGIN 
BEGIN 
BEGIN 
BEGIN 



SI 
SI 
SI 
SI 



SI 
SI 
SI 
SI 



+i; 
+i; 

+ i; 



DS 
DS 
DS 

DS 



LIT 
LIT 

LIT 

LIT 



» + n 

f» f ti 

« j ti 

W M M 



END 
END 
END 
END 



ELSE 
ELSE 
ELSE 
ELSE 



1 TO LL ELSE SI * SI ♦ i } ; 



U 
+P4; 



Pl 



si, 



D2/C OP EXP ^ 
* DBLV QR WH1 

ELSE wHi; 



MAX) 



PI «■ 

End; 

buff «- p; 

WHO] ♦ whi; 

GO TO COMM; 

% LOGICAL CONVERSION 

STREAM cPl + BUFF,P2«-Q*P3<-Q,P4«-W); 

BEGIN 

si <- pi; P3*si; 

P4(IF SCX" " THEN JUMP OUT 

TALLY <- 0) GO TO LLU 

LL! IF S C e ifT" THEN TALLY * 

llh p2 * tally/ si * p3j si «• si 

end; 

WHO] <- P* 
BUFF «■ p; 

DTAERR * ELMTYP i LOGV,* 
GO TO comm; 
% INTEGER CONVERSION 
NUMCONVERT* 

IF CDTAERR * DTAERR OR 
OR ELMTYP 
THEN GO TO COMMj 
W1C©3 * IF SGN THEN -WHI 
GO TO comm; 
% SINGLE PRECISION 
% E FORMAT 
% F FORMAT 
% G FORMAT 

numconvert; 

if cw1co] <■ whi) a then go to 

if (dtaerr * dtaerr or elmtyp = 

OR ELMTYP a INTEGV 
TH£N GO TO comm; 
TI «■ (IF EXP * THEN EXP ELSE ' 
-(IF FRTOG THEN D2 ELSE D); 
IF TKC-68) THEN TK--68 ELSE IF DTAERR*T1>68 THEN GO TO COMM 
IF Dl GTR 11 THEN IF TI GTR THEN 

DOUBLE C WHI, WH2, TEN t TI 3 * TEN[ 69 + T1 3 , TIMES, J *, WHI * WH2 ) 
ELSE 
BEGIN 
DOUBLE( WHi, WH2, TEN [-TH, TEN [69-T1J »/»!», WHi, WH2) J 
IF WH2 > P0007777777777700 THEN 

IF WHI. [9(6] LSS 14 THEN WHl ;» WHI + 1 & HHU2I2I7JJ 
END 
ELSE 
WHi * 

WHO] 



comm; 

LOGV 

OR ELMTYP* DBLV) 

•PS) 



IF T12 THEN 

ELSE 

«■ IF SGN THEN 



WH1XTENCT13 
WH1/TENC-T13; 
-WHl ELSE WH),; 



02846100 T 
02846200 T 
02846300 T 
02846400 T 
02846500 T 
02846600 T 
02846700 T 
02846800 T 
02846900 T 
02847000 T 
02847100 T 
02847200 T 
02847300 T 
02847400 T 
02847500 T 
02847600 T 
02847700 T 
02847800 T 
02847900 T 
02848000 T 
02848100 T 
02848200 T 
02848300 T 
02848400 T 
02848600 T 
02848700 T 
02848800 T 
02848900 T 
02849000 T 
02849100 T 
02849200 T 
02849300 T 
02849400 T 
02849500 T 
02849600 T 
02849700 T 
02849800 T 
02849900 T 
02850000 T 
02850100 T 
02850200 T 
02850300 T 
02850400 T 
02850500 T 
02850510 T 
02850530 T 
02850535 T 
02850540 T 
02850545 T 
02850550 T 
02850553 T 
02850555 T 
02850560 T 
02850565 T 
02850600 T 
02850700 T 
02850800 T 



042483 
0426 U 
0427*3 
0429*1 
0430*3 
0431*1 
0432*0 

0432*2 
0432*2 
0432* 3 
0433*0 
0433*2 
0434*1 
0436*0 
0436*0 
0437*3 
0437*3 
0438*1 
0440*2 
0441 *0 
0441*3 
0443*0 
0443*1 
0443»3 
0444*1 
0446*0 
0446*2 
0446*2 
0448*0 
0449*2 
0452*1 
0454*0 
0456*2 
0458*0 
0458*0 
0458*0 
0458*0 
0458*0 
0459*0 
0460*3 
0462*0 
0465*0 
0466*3 
0468*3 
0471*3 

0476*3 
0478*3 
0482*2 
0482«3 
0483*1 
0487*0 
0487*3 
0492*1 
0492*1 
0492*1 
0495*3 
0498*2 



i 



f * 



€ 



go to comm; 
dc: % double precision conversion 
numconvertji 

IF WH1 »= THEN BEGIN WHO] * W1C13 *WH1I GO TO COMM END; 
IF (DTAERR «■ DTAERR OR ELMTYP * DBLV ) 

THEN GO TO COMM; 
Tl «• (IF EXP t THEN EXP ELSE -PS) 

-(IF FRTOG THEN D2 ELSE D); 
IF Tl<(-68) THEN Tl«--68 ELSE IF DTAERR*T1>68 THEN GO TO COMM ; 
IF SGN THEN WH1 «■ - WHi* 
IF Tl > THEN 

DOUBLE (WH1#WH2# TEN t T 1 3* TEN[69+T13, ** «•* HI CO ]# Wl 1 13 ) 
ELSE 

00UBLECHHl#WH2*TENfTi3*TENC69*Tl]#/#*»WlCQ]#Hltl]); 

rt; 

********* e N d OF DECLARATIONS ***********; 
DE*1 AND EDITC0DEX3 THEN 

P(MKS) ; 
ITC0DE/6 THEN P (FlLX* DKADR )} P<FI#FMTA,*PC tLlSX ) ) > 
ITC0DE = 4 THEN PCEQFL* INK ALLC PARL> ?154 ) ) 
P(EDITC00E#E0FU»INTCALLCPARL»*160)) ; 

) ; 



COMM! 

END CONVE 

COMMENT * 

IF EDITCO 

BEGIN 

IF ED 

IF ED 

ELSE 

PCXIT 

END ; 

FIB * FJL 

IF FI8C53 

P(M«S 






IF EDITCO 
FNOL! 



FILXtNOT 43 * EOFL; FILXCNOT 3] 
XCNOT 23; % OPEN FILE IF NOT 
,C43I2] * <T1 ♦ 2 + CEDITC0DE = 53) 
#0*T1,FILXM#SELECT); 

ckp8; arraystuff*o; 
if pircoj * then 

FIBt03 ♦ 1 ♦ (EDITCODE =0 OR EDITCODE 

ELSE 
IF FI8C03 *\ + (EDITCODE *0 Or EDITCODE ■ 2) 
THEN P(MKS>FIB[63,FILX.[33S 15 3 * U, FORTERR ) ; 

DE = 1 THEN GO FNOL; GO FMTlST ; 



«- parl; 

OPEN 
THEN 



s2) 



lstrn*-i; 

go to frmtcd; 

FMTlSTJ 

LSTRN *• i; 

CTQG * DONETOG 
GETLIST; 

go to frmtcd; 



* false; 



yON* 
FRM|C 



NFPHi 
FMCYC 



Di 



PS *■ 
NFCI 



o; 

* (FI*8) 



+ 2; 



* FIRST FORMAT CHARACTER 

ER 



Nf'UI «■ Cf-1*BJ + di % PIKi>T FORMAT CMARAtT 

IF NFC X H C" THEN GO TO FMERRJ 

NFCI ♦ (FIx8) +2; % FIRST FORMAT CHARACT 

formatcontrol; % ANAYLSIS of format statement 

if fmerrtog then go to fmerr; 

if (donetog <- endlist) then reads; 

if in + ncr > lcr then go to fmerr; 

NCR *• W ♦ ncr; 

CONVERT; 

IF DTAERR THEN GO TO TYPERR; 

GETLIST; 



02850900 
02851000 
02851100 
02851200 
02851300 
02851400 
02851500 
02851600 
02851610 
02851700 
02851800 
02851900 
02852000 
02852100 
02852200 
02852300 
02862200 
02862210 
02862220 
02862230 
02862250 
02862260 
02862270 
02862300 
02862310 
02862400 
02862500 
02862600 
02862705 
02862706 
02862708 
02862710 
02862712 
02862714 
02862800 
02863900 
02864000 
02864100 
02882900 
02883000 
02883100 
02883200 
02183300 
02883400 
02883500 
02883600 
02883700 
02883800 
02883900 
02884Q00 
02884100 
02884200 
02884300 
02884500 
02884600 
02884700 
02884800 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 



0501*0 
050152 

030112 
0503*0 
0506*3 
0508*0 
0509*3 
0511*3 
0514*3 
0519*3 
052l»2 

0522*1 
0526*0 
0526*3 
0531*2 
053112 
0531*3 
0531J3 
0544*0 
0544*3 
0547*3 
0551*0 
0553*3 
0554*0 
0554*0 
0557*2 
0559*1 

0562*1 
0564*1 
0565*3 
0566*3 
0569*1 
0570*2 
0573*0 
0576*2 
0578*1 
0578*1 
0579*1 
0579*3 
0579*3 
0580*2 
0581*3 
0583*0 
0583*2 
0583*2 
0583*2 
0584*1 
0586*0 
0588*0 
0589*3 
0591*0 
0592*0 
0595*0 

0596*3 
0598*0 
0599*0 
0600*0 



IF CRPT<.RPTM) > THEN Go TO FMCYCj 

go 10 nfph* 

FMERR* 

PCMKS*FI8C6],FILX,C33*l5 3*0*FORTERR); 
TYPERR' 

P(HKS#FIBC6]^FILX,C33I15],2#F0RTERR)I 

END FTINTJ 






PROCEDURE FT0UTFIXCFILX,DKADDR,F-I,FMT,USX,EDITC0DE,E0FUPARU; * I NT? 157 

START OF REL 
VALUE DkADDR*FI.LISX*EDITCQDE*EOFl*PARL ; 

ARRAY FmTC*]; NAME FilXJ REAL DKADDR*F I * LI SX* ED I TCODE*PARL*EOFL '> 
BEGIN 

INTEGER LSTRN=19* E=17 J 
REAL 



* 




NAME LISTAODR ; 

ARRAY TEN«22C*3* AR 1 = L ISTADDR I * ] * TpAR=23C*3* FPB*3C*3* F 1 8 C * 3 * 

LABEL ALIST* GETNEXTPHRASE* REPEAT* TT* XX* SS* PP* AA* Al* 00* HH* 
CC* ERROR* GG* LL* FF* EE* II, DO* TEST* TESTl* AWAY* OVRFLW* 
BUMPWH3* MAXI* L0G8* THREH* ThREL* HLF* CONVERT* Dl* QVRFLWl, 
FIVPT* JJ* RAPUP* XI* 0VRFLW2* ONE* OUTSUB* CO* NLEL* FQ94* 
F09S* VERROR, HV* C01* CMSK* REPEATl* IEDIT* TENU* ONDG* CKH* 
STNRO* SE* TWHLF* DREST* DRESTi* HLFl* FIVPT1* SQN* 0VRFLW3* 
TESTg, REPEAT2*. STNRD1* XPIV* GOTE* NK 5 

SWITCH PHRASE«>SS*HH*PP*XX*TT*AA*00*LL*JJ*II*GG*FF*EE*DO'CC i 



9 LSTRNa(-l) #* 
a 3 #, 

#* 



DEFINE DONE 
REEL 

LOGICAL » 4 
INTFGR * 1 #* 
DBLPRECSN e 5 

COMPLEX ■ 6 #* 
MAXCQDE *. 15 #* 

VERRCVERR1) B BEGIN PCVERR1); GO VERROR END #* 
MAYBECMAYBE1*MAYBE2*MAY8E3) * C I*C I+MAYBEU GO 

DS«-LIT MAY8E3; M. 
TWOD - UlSTYPE,C38lt) #* 
INOXF = [18115] #* 
TYPEF = £44*43 9, 
SIZEF = C33U53 * ; 

SUBROUTINE BLANKIT * 



#* 

#* 
» BEGIN 



TO MAYBE2 
AYBE2S #* 



02884900 


T 


060110 


02885000 


T 


0603*1 


02885100 


T 


0603*3 


02885110 


T 


0603*3 


02885400 


T 


0605«3 


02885500 


T 


0605«3 


02885800 


T 


060713 




SIZE* 0608 


' 02886000 


T 


0000*0 


*el segment; disk 


address ■ 


02886040 


T 


000080 


02886080 


T 


0000*0 


02886120 


T 


0000*0 


02886160 


T 


0000*0 


02886200 


T 


0000*0 


02886240 


T 


0000*0 


02886280 


T 


0000*0 


02886320 


T 


0000*0 


02886360 


T 


0000*0 


02886400 


T 


0000*0 


02886440 


T 


0000*0 


02886480 


T 


0000*0 


02886520 


T 


0000*0 


02886560 


T 


0000*0 


02886600 


T 


0000*0 


02886640 


T 


0000*0 


02886680 


T 


0000*0 


02886720 


T 


0000*0 


02886760 


T 


0000*0 


02886800 


T 


0000*0 


02886840 


T 


0000*0 


02886845 


T 


0000 8 


02886850 


T 


0000*0 


02886855 


T 


0000*0 


02886880 


T 


0000*0 


02886920 


T 


0000*0 


02886960 


T 


0000*0 


02887000 


T 


0000*0 


02887040 


T 


0000*0 


02887080 


T 


0000*0 


02887120 


T 


0000*0 


02887|60 


T 


0000*0 


02887200 


T 


0000*0 


02887210 


T 


0000*0 


02887215 


T 


0000*0 


02887240 


T 


0000*0 


02887280 


T 


0000*0 


02887320 


T 


0000*0 


02887360 


T 


0000*0 


02887400 


T 


0000*0 


02887440 


T 


0000*0 


02887480 


T 


0000*0 


02887482 


T 


0000*0 



WORDS 



00350 



• 
« 



t 



• 

• 



* * 



• 



BEGIN 
STREAM(A*BSIZE"l#B*P(DUP)*t36i6]»T21#BUFF) '» 

BEGIN 

SI*T2i; DS<-WDS; SI*BUFF; DS*A WDSJ BCDS«-32WDS; DS*32WDS) ; 

END t 
END OF BLANKIT ; 

SUBROUTINE OUTPUT ; 
BEGIN 

IF PRNTR THEN 
BEGIN 
STREAM(Q*.OiSAVBUFF) * 

BEGIN DI*LOC Qi SI*SaVBUFF; Dl*DI+7; DS*CHR END ; 
Ti*IF (Tl*P)» w + n THEN ELSE IF Tl>9 THEN 16 

ELSE IF T1*0 THEN 32 ELSE T1J 
IF NOT C THEN f IB [ 17 3**P< DUP )+BSlZE i 

P(MKS,Tl.t42*23»Tl AND 15, C . BSI ZE»FILX* ALGOLWRITE ) I 
FIB[63*-*P(DUP)-((C*0) = TD i 

P(MKS^FuG#DKADDR*0*('l)»FlLX#ALGOLWRITE#DEL) > 
STREAMQ«-BUFF*SAVBUFF,BSIZE,BSZ«-PCDUP)-1*T21>S«-*FILX) i 
BEGIN 

si*oj si*si + ii ds«-bsize wds* di«-q; si*t2i; ds*9chr ; 
si+q; si*si+i; ds«-bsz wds ; 

END I 
FIB[173**P(DUP)-BSIZE ; 
END 
ELSE BEGIN 

P(MKS,FLG>DKADDR*0'8SIZE>F I LX> ALGOLWRITE) i 
IF LSTRNX(-l) THEN 

BEGIN 

PCMKS»F|_G,DKADDR#0,(-n,FlLX, ALGOLWRITE* DEL) i 

buff«-savbuff«-(*filx), [33*153; blankit i 

end ; 
end ; 

CHR«-0 ; 

end of output ; 

subroutine skip i 

IF CTl«-P(XCH)) GEQ W THEN Ti*W 
EtSE BEGIN 

STREAM<T2UQ*W-T1#T«.PCDUP),[36I6]#BUFF) ; 

BEGIN 

SI*T2l; DS*Q CHR; T(SUT2U DS«-32CHR; DS«-32CHR) ; 

T2i*oi ; 

END i 
BUFF<-P J 
END OF SKIP ; 

REAL SUBROUTINE NXTELM ; 
BEGIN 
PCIF TWDT THEN P C* [ AR1 1 INDX . C 33 * 73 3 3 , INDX AND 255»C0C) 

ELSE ARHINDX3) ; 
INDX«-INDX + 1* NXTELM«-P i 
END OF NXTELM ; 

SUBROUTINE GETNEXTLISTELEMENT I 
BEGIN 



02887484 
02887486 

02887488 
02887490 
02887492 
02887496 
02887498 
02887520 
02887560 
02887600 
02187640 
02887680 
02887720 

02887760 
02867800 

02887840 
02887880 
02887920 
02888160 
02888200 
02888240 
02888280 
02888320 
02888360 
02888400 
02888440 

02888480 
02888520 
02888560 
02888600 
02888640 
02888680 
02888720 
02888760 
02888800 
02888840 
02888880 
02888920 
02888960 
02889000 
02889040 
02889080 
02889120 
02889140 
02889160 
02889200 
02889240 
02889280 
02889320 
02889360 
02889400 
02889440 
02889480 
02889520 
02889560 
02889600 
02889640 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0001*0 

oooiso 

0003*2 
0003*2 
0006*0 
0006*1 
0006*2 
0006*2 
0007*0 
0007*0 
0007*1 
0007*3 
0009*0 
0010*1 
0013*1 

0016*2 
0020*1 
0023*0 
0026*0 
0028*1 
0031*1 
0031*1 
0033*0 
0034*0 
0034*1 
0036*1 
0036*1 
0036*3 
0038*2 
0039*2 
0040*0 
0042*1 
0045*0 
0045*0 
0045*0 
0045*3 
0046*0 
0046*0 
0046*0 
0047*3 
0049*0 
0051*3 
0051*3 
0054*0 
0054*1 
0054*2 
0055*0 
0055*1 
0055*1 
0056*0 
0056*0 
0059*0 
0060*0 
0061*2 
0061*3 
0061*3 
0062*0 



€ 

€ 



« 



• 
• 



IF NEEDNEWLlSTELEMENT THEN 
BEGIN 

IF ARY THEN 

BEGIN 

alist; pcnxtelmj; if dblprec then wh2«-nxteum; ary*indx<size; 

END 
ELSE IF TYPEsCOMPLEX THEN 

BEGIN TYPE«-REEL; P(LISTADDR£ 1 3 ) END 
ELSE BEGIN 

P(ARRAYSTUFF*0); LISTADDR«-CLISX 3 ; 
DBLPREC* CTYPE*L I ST YPE,TYPFF)=DBLPREC5n ? 
IF ARY*ARRAYSTUFFXO THEN 
BEGIN 

IF TYPEpCOMPLEX THEN TYPE«-RE£L '> 
SIZE«-(INDX«-ARRAYSTUFF f INDXF) + 

ARRAYSTUFF,SIZEF } 
P(LlSTADDR4.MEMCLISTADDR.tt8U5]3) i 
TWDT*NQT PcLOO'TOP); PCDED i 
GO AtlST i 
END ; 
PCDEUlISTADDRto:!} i 
IF DBLPREC THEN WH2*LISTAD0RU 3 ; 
END ; 
T5«-WH1*P J 

Fro > 

IF CNLLC^LIr'LlfTLlLMENTi 1 )*E.C-ITcPLL 
AWAYJ BEGIN OUTPUT; P(XIT) END ; 

END OF GFTNExTLlSTELEMENT ) 



OK iVVL THEN 






,b<JcjtA 



SUBROUTINE NLF / 

BEGIN P(XCH); WH2«-o; getnextustelement ; 

IF WH1+4>PCFQ94J THEN 

BEGIN IF Tl THEN VERRCP+.lO)! P(DEL,F094) END 
ELSE IF P(DEL»C-P(F094)),DUP)<WHl THEN P(DEL>WH1) ; 
PCXCH) i 
END OF NLE '> 

SUBROUTINE HANDLEVARI ABLES I 
BEGIN Tl*l t 
IF R*P(F095) THEN 

BEGIN PCO); NLE/ T1*PC.R#ISN)>0 ; 
IF C0DE«29 THEN 

BEGIN PCFI+SAVW) } 

IF R£0 THEN PCCFMT[P]3,OUP#LOOfP«RC6i36U23tXCH) 

ELSE PC.FI3 ; 

PCSTN) ; 

outsub* pcdel>ded; 

END '> 

end ; 
if t4«-c0de=30 then 
begin P(2>j nle; 



go getnextphrase 



pc.ndmsn) i 

STREAM(P1*PIP2*P(C0)#P3*P£C01 J) i 

BEGIN SI«-LOC Pi; Sl*SI+7; DIALOG P2i DI*DI + 1 ; 

32(IF SC«DC THEN JUMp OUT; TALLY*TALLY + l; SI<-SI-1) 

P1*TALLY / 

END ; 
IF (NO AND 63)*ND THEN P(DEL*32) ; 



02889680 


T 


006g*0 


02889720 


T 


0062»i 


02889760 


T 


0062*3 


02889800 


T 


006310 


02889840 


T 


0063*2 


02889880 


T 


0067*3 


02889920 


T 


0068*3 


02889960 


T 


0070*0 


02890000 


T 


0072*1 


02890040 


T 


0072*3 


02190080 


T 


0074*1 


02890120 


T 


0076*2 


02890160 


T 


0077*3 


02890200 


T 


0078*1 


02890240 


T 


0080*1 


02890280 


T 


008l*2 


02890320 


T 


0083*0 


02890360 


T 


0085*0 


02190400 


T 


0066*2 


02890480 


T 


0087*0 


02890520 


T 


0087*0 


02890560 


T 


0067*2 


02890600 


T 


0089*3 


02890640 


T 


0089*3 


0j890680 


T 


0090** 


Ctt 9072C 


T 


cc?c»i 


02890725 


f 


0093*1 


02890730 


T 


0095*1 


02890735 


T 


0095*2 


02890740 


T 


0095*2 


02890745 


T 


0096*0 


02890750 


T 


0098*0 


02890755 


T 


0099*1 


02890760 


T 


0102*0 


02890765 


T 


0105*0 


02890770 


T 


0105*1 


02890775 


T 


0105*2 


02890780 


T 


0105*2 


02890785 


T 


0106*0 


02890790 


T 


0106*3 


02890795 


T 


0107*2 


02890800 


T 


0110*2 


02890805 


T 


Olllll 


02890810 


T 


0112*2 


02890815 


T 


0115*3 


02890820 


T 


0116*2 


02890825 


T 


0116*3 


02890830 


T 


0117*3 


02890835 


T 


0117*3 


02890840 


T 


0117*3 


02890845 


T 


0119*0 


02890850 


T 


0121*2 


02890855 


T 


0122*3 


02890860 


T 


012313 


02890865 


T 


0125*3 


02890870 


T 


0126*0 


02890875 


T 


0126*1 



• 
• 



• 

# 



• 
• 
# 



-> * 






IF CC00E*P+3)>MAXC0DE AND Tl THEN VERRC2) S 

T1«-C00E>4 AND Tl ; 

END ; 
T2*T1 ; 
IF PCCODEill AND CODES 1 «» F095 )=SAVW THEN 

REGIN P( ,SAVW>4) ; 
NLEL* NLE; P<XCH#ISD)J T1*P(DUP) AND T2«-T2 AND SAVW>0 } 

end ; 
if savd=pcf095) then begin pc.savd>6); go nlel end ; 

IF COOES4 THEN 

BEGIN IF T4 THEN SAVW*RJ 

FMTW*FMTWS(P(OUP).Ulll3+(SAVH<0>)Cftll47ll3; GO HV * 
END > 
IF NDT 12 THEN GO OUTSUB; IF cODE 3 5 THEN HV8 R*i J 
IF PCDUP) AND SAVD<0 THEN VERR{16) ; 

IF T4 THEN IF SAVW=P(PQ94) THEN BEGIN IF CODE/9 THEN V£RRC6)END 
ELSE IF PCDUP) AND SaVD*PCF094) THEN 
BEGIN PC7) ; 
VERRQR* T4«-p; P( MKS* CODE* R# SAVW* SAVD* T4* WH 1* WH2*FMTW, 

C-5)»F0RTERR) * 
F094 S S « 4094 J 
F0958J8 4095 ; 

CDt J J §0047676321464341 ; % OPXTAOLJ 
CD1 * * S P3127262524230000 } % IGFEDCOO 

END ; 
IF NOT P THEN SAVD*0 ; 
END OF HANDIEVARIABLES * 

REAL. SUBROUTINE SETUP ; 
BEGIN 

P(XCH,OUP) i 
IF DBLPPEC THEN 
BEGIN 

IF P>ND THEN BEGIN T6*P-Nd; P(ND) END ; 
IF (T5*.(T4*P)«T3*N0*16)'<0 THEN 

BEGIN P(WH3/TEN[-T5],.WH3>ISD)J T3«-T4 END 
ELSE IF T5 LSS 8 THEN 
BEGIN 

IF P(WH2/TENC8*T2*T53*,WH2#lSN)sTENCT23 THEN 
BUMPWH38 WH3*WH3+1 5 

END 
ELSE IF P(WHl/TENCi6-T5],.WHl»ISN)*TENCTUT5*T2«-83 

THEN IF (WH2«-WH2 + 1)*T8 THEN GO BUMPWH3 * 
END 
ELSE BEG I N 

IF CT3*P)>11 THEN T6*T3*"T3«- C PC WH1 , TENC ABS(E ) 3 t IF E>0 

THEN PC/) ELSE P(x> JSPCFIVPT ) > + l 1 * 
IF CQ0E*i2 THEN P(SCALE,+) * 

PCP'El'T6*WH3#XCH»TENtABScPCDUP))3*IF PCXCH)<0 THEN PC/) 

ELSE PCx)f f WH3*ISD) ; 
END ; 
E1*PCTEN[T33"WH3#DUP)+Ei; SETUP*P * 
END OF SETUP ; 

%************************ 5 t CODE STARTS HERE 8 J A************************ 
FI8*FILXCN0T 23; P C TEN [ 8 ] * .T8> I SD ) ; 



02890880 
02890885 
02890890 
02890895 
02890900 
02890905 
02890910 
02890915 
02890920 
02890925 
02890930 
02890935 
02890940 
02890945 
02890950 
02890955 
02890960 
02890965 
02890970 
02890975 
02890980 
02890985 
02890990 
02890995 
02891000 
02891005 
02891010 
02891015 
02891020 
02891025 
02891030 
02891035 
02891040 
02891080 
02891120 
02891160 
02891200 
02891240 
02891280 
02891320 
02891360 
02891400 
02891440 
02«91480 
02891520 
02891560 
02891600 
02891640 
02891680 
02891720 
02891760 
02891800 
02891840 
02891880 
02891920 
02891960 
02892000 



0128*2 
0131 * 3 

0133*2 
013382 
0134M 
0136'3 
0137«3 
0142« 1 
014281 
014482 
014581 
014781 
015110 
015180 
015383 

0156*1 
0160*1 
0162*0 
016213 
0165*2 
0166*1 
0168*0 
0169*0 
0170*0 
0171*0 
0l7ji0 
017282 

0172*3 
0172*3 
0173*0 
0173*0 
0173*2 
0173*3 
0174*1 
0176*2 
0179*2 
0182*2 
0183*3 
0184*1 
0187*2 
0189*1 
0189*1 
0193*2 
0196*3 

0196*3 
019781 

0200*1 
0204*2 

0206*1 
0210*0 
0211*1 
0211*1 
0213*3 
0214*0 
0214*0 
0214*0 
0214*0 






F FIG*DKADDR<0 THEN D 
F PCFIBC5]#DUP)iC43ll 
«-(P AND 963*0 i 
AXCHR*(BSIZE*P<MKS*FL 

PftNTR*(CTUFIBC 
FPBCFI8C 

F NOTCNOTCNEEDNEWLIST 
F NOT TPAR. [14513 THE 
BEGIN 

E*PU#CE]#CFx#SFB 
STREAM(A«-PC2l,CE3 
P(TPAR,1,25*C0M,D 

END > 

21*P(tTPARC2l33) INX 

F PRNTR THEN 
8EGIN 

IF BSIZE>16 THEN 
IF C THEN BEGIN B 
PCPCCMSK) CR TPAR 

END 
LSE PCPC *FILX 3 # C 33 « 15 

UFF*SAVBUFF*P > 
F NOT PRNTR THEN BUAN 
F FlBC03*0 THEN FIBtO 
F CLSTRN + n*FIB[03 AN 

BEGIN T3*4 ; 
i PCMKS,FIBE7J,FILX 

END i 

(0) ; 

XTPHRASE* 

«-P(FMT[FI«-Fl + 13»DUP), 
AVW*PC0UP).ri8H23; 
F (XTRA«-P(DUP> AND 63 
LSE PCPCCD«-P(DUP) ANO 
LR?GN*P; COMMAS<-P ; 
F P. [42*13 THEN IF (F 
F CODEsG THEN 

BEGIN 

IF SAVD^O THf.N 

BEGIN GETNEX 
IF PCDUP).C18I15] 
IF PCCNOT Q)*XCH> 

GO GETNEXTPHRASE 
FIVPTJ!? 5,^9755813885 ; 

end ; 
co0e«5 then chr«-r*q 



KADDR«-0 ) 

3 THEN P(MKS#0#0*FILXM»SElECT) '* 



G#DKADDR#0# 
4].[8l43)«l 
43 t U3»113 + 

EtEMENT*EDI 
N 

)&29 te« 38 S 1 
)>; BEGIN D 
EL>DEL>; E 



C-13#FILX»ALG0LWRITE3)X8* 

OR Tl*12 OR Tl-7) ANO 
33.[43*53<20 ; 
TC00E=3) OR FMTCFI3) THEN GO ERROR; 



03 ; 

s<-8UT" *•; si*a; ds«.7Wds end ; 

«-o ; 



♦ 17J MAXCHRM33 END * 

X i; TPAR[03* H "J BLANKIT END I 



E 
B 
I 
I 
I 

ERROR 

P 
GETNE 
R 
S 
I 
E 

I 
I 



BEGIN BSIZE 
UFF*TPAR IN 

3 ; 

33 I 

kit ; 

D Tl*2 THEN 



,C33!133,T3,F0RTERR) * 



C6«12Ji IF 

SAVD«-(FMTW«- 
),U4*23=0 
15)«12,DUP 



fCODE<-P(OUP)»Cl?533=2 THEN GO HH J 
PCDUP3). [30*123 i 
THEN PCO*0) 
) OR D*8*P(XCH3 OR 0*43 ; 



MTW AND 3)sO THEN HANDIEVARI ABLES i 



TLISTEUEMEN 
tri THEN PC 
INX»DUP).C3 



t; output; neednewu$teuement«-oend; 

R&FIC18I33I153) ; 

31153*0 THEN PCDEDEL.SE FI*FI-SAVW| 



IF 
REPEAT! 

IF C0DE>5 THEN 
REPEAT! i GETNEXTLISTELEMEN 
REPEAT25 

IF CCHR*(W*5AVW)+CHR)> 
IF C0DE>9 THEN IF CODE 
BEC I N 

SGN«-WH1,CU13; DECPT*C0DE>10 ; 
IF C0DE<13 THEN 

IF ABSCWH1)< 
IF W<64 



it ; 

•MAXCHR THEN 
:S14 THEN 



IF CODECS AND C0DE*9 THEN GO AWAY; 



:P(TEN11) AN 

AND NOT (CO 



D NOT CODE THEN 

MMaS OR DLRSGN OR DBLPREC3 THEN 



02892040 
02892080 
02892120 
02892160 
02892200 
02892205 
02892240 
02892250 

02892255 
02892260 
02892265 
02892270 

02892275 
02892276 
02892280 
02892320 
02892360 
02892440 
02892445 
02892480 
02892520 
02892560 
02892565 
02892600 
02892640 
02892680 
02892720 
02892760 
02892800 
02892840 
02892880 
02892885 
02892890 
02892895 
02892900 
02892905 
02892920 
02892960 
02893000 
02893005 
02893040 
02893080 
02893120 
02893160 
02893200 
02893240 
02893320 
02893360 
02893365 
02893370 
02893375 
02893380 
02893385 
02893390 
02893395 
02893400 
02893405 



0226*2 
0229*0 
023251 
0233*3 
0236*3 
0240*3 
0245*0 
0247*2 
0249*0 

0249*2 
0252*0 
0255*0 

0257*2 
0257*2 
0259*0 
0259*1 

0259*3 
0262*2 
0267*0 
0268*0 
0268*0 
0269*2 
0270*2 
0273*0 
0275*3 
0278*1 
0279*2 
0281*2 
0281*2 
0281*3 
0281*3 
0286*1 
0289*3 
0293*0 

0297*3 
0298*3 
0303*0 
0303*3 
0304* 1 
0305*0 
0308*3 
0311*2 
0315*1 
0316*3 
0318*0 
0318*0 
0320*2 
0320*2 
0321*1 
0323*0 
0323*0 
0327*2 
0330*1 
0330*3 
0333*1 
0334*0 
0336*1 



# 



• 
• 



< • 



i 






BEGIN 

IF NOT DECPT THEN 

BEGIN 

IF PCE1*W,aBS(WH1),,WH2,ISN)>9 

THEN GO IEDlT ; 

IF P(SGN+l,-#DUP)fcO THEN GO ONDG 

GO OyRFLWl * 

END ; 
IF (T1 + 11-D«-SAVD><0 THEN GO STNRDl I 
IF CE1*H-D-1)<0 THEN GO OVRFLW * 
PCT6*03* IF WHisO THEN BEGIN WH2*0» 
PCTENt03'DUP#ABS(WHD) ; 
IF SCALE^O THEN 

BEGIN 

IF PCTENUbSCSCALEHjIF scale>o 

ELSE PC/)>oUP)iP<TENH) THEN GO 

P(,WH1*STN) * 

END * 
IF P<DUP>HlFl*-,,,WH2#ISN#-#x,,T5>lSN) = P 



WH2*WH2+1 END i 



IF 



IF 



CKH 



CMSK* * * 
HLF1»I» 
TENUM 



ONDG* 



<?>700000 I 

0,5 ; 

99999999999.0 



BEGIN T5*0S 

T5/o then 

BEGIN P(OEL'IO) J 

if D>8 Then 

BEGIN P(DEL>5) ; 
T2*T5 DIV T8* 0*0"8 i 

end ; 

END J 

WH2<lO THEN 
BEGIN 

IF PCE1-SGN*1#0UPX0 THEN 
BEGIN 

IF WH2/0 THEN GO 0VRFL«2 i 
P(DEL) ; 
IF E1*0 THEN 
BEGIN 

IF SGN THEN 60 
ELSE GO DRESTl 



J 



} 



GO ckh end; 



THEN PCX) 
STNRD * 



THEN 



OVRFLWl 
i 



DRESTl 
DRESTl! 



END 

P(SGN*0)* WH2* M *" * 
END * 
STREAM(S*PsT21#WH2,SGN*BUFF) * 
BEGIN 

si*T2i; ds«-s chr; maybecsgn,li> h - w ) * 
5i«-loc sgn; si*-si-i ; ds*chr* s*di * 

END * 

IF NOT DECPT THEN GO TEST i 
BUFF«-P; P(WH2X0) ; 
IF CE*P)>Tl THEN 

T6*E-T1-.(ABSCWH1)<TENCE"13XP(FIVPT1)) ; 
STREAM(Q*PtD,T2»T5>T6*BUFF) ; 
c r r t m 

DS*LlT M ."* CI*CI+Q* SI*L0C T5*SI*SI+2* 
DS«-D CHR; GO L2* SI*LOC T2* DS«-D DEC ; 
DS«-80EC; GO L2; SI*LOC t5; ds«-d dec ; 



02893410 
02893415 

02893420 
02893425 
02893430 
02893435 
02893440 
02893445 
02893450 
02893455 
02893460 
02893465 
02893470 
02893475 
02893480 
02893485 
02893490 

02893495 
02893500 
02893505 
02893510 
02893515 
02893520 
02893525 
02893530 
02893535 
02893540 
02893545 
02893550 
02893555 
02893560 
02893565 
02893570 
02893575 
02893580 
02893585 
02893590 
02893595 
02893600 
02893605 
02893610 
02893615 
02193620 
02893625 
02893630 
02893635 
02893640 
02893645 
02893650 
02893655 
02893660 
02893665 
02893670 
02893675 
02893680 
02893685 
02893690 



T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 

T 
T 
T 
T 
T 
T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0339*1 
0339S3 
0340*1 
340! 3 
0342*2 
0343*2 
0345*3 
0346*1 
346*1 
0349*0 
0351*3 
035510 
0356*1 
0357*0 
0357*2 
0359*3 
0361J3 

0362*1 
0362*1 
0364*3 
0367*1 
0368*0 
0369*0 
0369*3 
0370*3 
0373U 

0373*1 
0373*1 
0374*0 
0374*2 
0376*2 
0377*0 
0378*1 
0378*2 
0379*1 
0379*3 
0380*0 
0381*0 
0382*0 
038310 
0384*0 
0384*0 
0385*2 
0385*2 
0387*1 
0387*1 
0389*1 
0390*1 
0390*2 
0391*1 
0392*2 
0393*2 
0397*3 
0399*3 
399*, 3 
0401*1 
0402*3 



4p 



JUMP OUT); 



IEDITI 



12? Q«-DI > 

t6cdi«-0i-t6;t6{0s«-lit"0'v); 

end ; 
go test ; 

END J 
IF PCE1-SGN>DUP)<9 THEN 
BEGIN 
STR£AM(E1«-P#WH2>SGN*BUFF) ; 

begin si*loc WH2; ci*ci+sgn; go li ; 
ds*lit w o»; ds*ei dec; ei*di; dubuff ; 
if toggle then tally*!; ds*8 fill ; 

DI*DI-l; DS«-LlT--'«; GO L2; Lis 
OS«-El DEC; IF TOGGLE THEN TALLY*! ; 

ei«-di; di*buff; ds*8fill; L2* wh2*di ; 

sgn*taLly ; 

end ; 
if p then go sqn else go qvrflw3 ; 
end ; 

IF WH2<T8 THEN 
BEGIN 

p(del) ; 

stream (wh2,s*e 1-8 *t21>sgn# buff) ; 

BEGIN 

si*T2i; os*s chr; s*di; si*loc wh2 ; 
ds*8dec; wh2*di; di*s; ds*8Fill; s*di; 
ci*ci+sgn; go li; di*oi-i* ds*lit»^ m ; 

LI? 
END ; 
GO sqn ; 
end ; 
ei*p ; 

streamcwh1*wh2 oiv t8> wh2,t21 * 5* if e1>16 then pc 
e1^16»8) else p( 0, el-8 )#e1«-p» sgn, buff ) ; 

BEGIN 

ds*sgn chr; s*di ; 
dec; if toggle then 
whi*oi; t2i«-tally; oi*s ; 
ci*ci+sgn; go li ; 



Son 



fivpti* 
stnrds 



STNRD1S 



si*T2i; ds«-s chr; 

SI*LOC WHl; DS*E1 
TALLY*i; DS*8DEC; 

ds«-6fill; wH2*di; 

DI*DI 

end ; 

if not p then go 0vrflw3 

IF NOT DECPT THEN 

BEGIN PCDEL'XCH#DEL); 
E1*p; BUFF*P ; 
IF W<13 THEN GO DRESTl I 

pco«pf (1 + buff) inx cnot e 1 ) ) c 43 j 46 * 23 

+buff.c30s33-e1.c30j33) ; 
go drest ; 



u ds*lit»-»; us 
; 

GO TEST END ; 



S5. 49755813885 i 

PCDEL>DEL*DEL>DEL) 

End ; 

d*savd ; 
p(xpiv»whi«0) ; 

if not dblprec then 

BEGIN 

IF P THEN GO GOTE * 

P(TENCABS(E*(P&(WHUABS(WHl) 



; 



MOD PCMAXI))C9J3J63S 



02893695 
02893700 

02893705 
02893710 
02893715 
02893720 
02893725 
02893730 
02893735 
02893740 
02893745 
02893750 
02893755 
02893760 
02893765 
02893770 
02893775 
02893780 
02893785 
02893790 

02893795 
02893800 
02893805 
02893810 
02893815 
02893820 
02893825 
02893830 
02893835 
02893840 
02893845 
02893850 
02893855 
02893860 
02893865 
02893870 
02893875 
02893880 
02893885 
02893890 
02893895 
02893900 
02893905 
02893910 
02893915 
02893920 
02893925 
02893930 
02893935 
02193940 
02893945 
02893950 
02893955 
02893960 
02893965 
02893970 
02893975 



0404*0 
04Q4* 1 

0407*1 
0407 * 2 
0408*0 
040810 
040912 
0410*0 
0411 «2 

041212 
041410 
041413 
0415*3 
0416*3 
0417*3 
0418*0 
0418*1 
0419U 
0419* 1 
0420*0 

0420*2 

0420*3 

0423*1 
0423»i 

0424*2 
0425*3 
0427*1 
0427*1 
0427*2 
0428*0 
0428*0 
0428*2 
0431*2 
0434*3 
0434*3 
0436*1 
0437*1 
0438*2 
0439*3 
0440*2 
0440*3 
0441*1 
0441*3 
0443*2 
0444*2 
0445*3 

0447*2 
0450*1 
0450*3 
0452*0 
0453*0 
0453*0 
0453*3 
0454*3 
0455*1 
0455*3 
0456*2 






• 






I » 



GOTE* 



IF 
IF 



IF 



ELSE 



E<0 
P(>) 

BE 
E* 
EN 
CODE 
IF 
TH 

N0M2J 

END 

IF P AN 

BEGIN 

P(WH1*A 

IF (P A 
IF CE+C 

TH 

ELSE PC 

ti*p* 

P(WH2#W 
PCDLM 

IF T1>P 
ND*P * 
IF ND>? 



1[1I2UJ+P(TWhLF)>xP(L0G8))J»WH1> > 
P(x,ONE#XCH) } 



WH 
THEN 

THEN 
GIN P(E-l) ' 

p ; 

D i 
«13 T 

NOT 

EN GO 

WH3* 



'HEN 

(whl/o and (dlrsgn or d>16 or d+scale>11)> 

se ; 

WHl I 



D WH2sO THEN BEGIN WH3«-E«-P; ND*24 END ELSE 

BS(WHD) i 

ND P(NK)}«0 THEN Wh2+PC 0#ONE> WH2# WHl*OLM# , WHl *<• ) * 

P*<WH3*WHl}C9»3l6]«HHitll2:l3*P(TWHLF))xPCL0G8})<0 

EN P(0*ONE'TEN[69*E3*TENC-E]»DLD) 

TEN[E+69},T£NCE3) ; 

IF (P>WH2 AND T1*Wh1) OR T1>NH1 THEN E*E-1 i 

H1#TEN[69+ABS(E)]*TENCABS(E)]»IF 0>E THEN 

) ELSE P(DLD)) ; 

T3<-p; PC24) * 

(THREH) THEN P(T 1>P(THREH) OR T3>P (THREL ) »* ) * 



G 
HLFJ J 
MAXI * 
ONES » 
XPIV» 
TWHLF 
NK> M 
THREH 
THREL 
L0G6* 
SE* I 
I 
I 



ELSE PCWH2*W 

THEN 
WH14-P \ 
P(T3«-P'WH1>T 
T3>l*<Hl»0>W 
WH1*P i 
P(T3«-P*WH1#G 
0,WH2,0#T8 
END ) 
IF T4«.(T1«-T2«-T3*-T 
ELSE BEGIN P(E+1) 
El«-P i 

end \ 
phrascccode-u * 



O+E THEN P(HH2#WHl*TENtND+69]»TENCND3»DLM# 
TENt68"'E3i.TEN[-E~l3>DLM) 

Hl#TENCCTl«-ABSCND-E-l)) + 69 3*TENETi3,IF ND<E 

PCDLO) ELSE P(DLM)) i 



6«-TENC85 3»T4»-TENC163*DLD#HLF#**,WH3*lSD»DEL* 
H3*T6#T4*DLM#DLS) ; 

#T8»0LD*HLF#-,,HH2*IS0*0EL»T3»WHl# 

,DLM,OLS*.WHl,ISD*DEL> i 

6*0)«MH3 THEN P(C"NO>) 

i IF C0DE*12 THEN PCSCALE# + ) END '> 



0.5 

$077 

1.0 

0113 

12,5 

POOO 

^115 

PQOO 

** 0,90 

F PCW-D- 

F P(DUP) 

F WH1 = 

BEGI 

STRE 



*s : 
: s i 



l 

7777777777777 

ooooooooooooo 

7000000000000 

3013331500045 

3H2121167260 

308998709 } 

5-5GN*DUPJ<0 

>63 THEN BEGI 

THEN 

N 

AM(SKP«-PiT21»SGN*D*D + 3»Dl*PCDUP)iC36l6 3#BUFF). * 

BEGIN 

SI*T2i; DS«-S 
SI«-T2i; DS«-D 



THEN GO OVRFLWl * 

N PCW#XCH*SUB#63#+)J SKIP; PC63) END J 



kp chr; maybe(Sgn»li» m ^ m ); ds«.2l.it",o" ; 

CHRJ Dl(SI*T2li DS*32CHR; DS+32CHR); skp*di ; 



02893980 
02893985 

02893990 
02893995 
02894000 
02894005 
02894010 
02894015 
02894020 
02894025 
02894030 
02894035 
02894040 
02894045 
02894050 
02894055 
02894080 
02894120 
02894160 
02894200 
02894240 
02194280 
02894320 
02894360 
02894400 
02894410 
02894425 
02194440 
02894480 
02894520 
02894560 
02894600 
02894640 
02894680 
02894720 
02894760 

02894800 
02894840 
02894880 
02894960 
02894965 
02894967 
02895000 
02895040 
02895045 
02895050 
02895055 
02895060 
02895065 
02895070 
02895075 
02895080 
02895085 
02895090 
02895095 
02895100 
02895105 



0458*3 
0462*0 

046410 
0464*1 
0465*2 
0466*0 
0466*0 
0466*3 
0470*3 
047l*2 
0473*0 
0473*0 
0476*3 
0477*1 
0478*1 
0482*0 
0486*0 
0489*2 
049l*2 
0496*1 

0499*2 
0501*0 
0502*1 
0505*2 
0506*0 
0510*0 
0512*2 
0517*0 
0519*0 
0519*2 
0523*3 
0525*3 
0526*1 
0529*2 
0531*3 
0531*3 
0536*0 
0539*0 
0539*2 
0539*2 
0548*2 
0550*0 
0551*0 
0552*0 
0553*0 

0554*0 
0555*0 
0556*0 
0557*0 
0556*0 
0561*0 
0565*1 
056610 
0566*2 
0569*2 
0569*2 
0572*0 



€ 

• 
• 
• 



« 



41 

• 



# 
* 



TT! 

XX! 
XI! 
SSJ 

CC1 
AAi 
All 



'.Vb %m " ■ 

PP» 
00! 



end ; 

GO TEST ) 
END I 
ND*E J 
IF SCALED THEN 

IF SCALE<0 THEN 

BEGIN IF P(1-SCALE*DUP)>D THEN GO 0VRFLW2 END 
ELSE BEGIN 

IF PCSCA(_E,-,DUP)<0 THEN GO 0VRFLW1 ; 

pcskp*P); d*d+scale; e*e»scale; P(l) J 

END 
ELSE BEGIN IF D-0 THEN GO OVRFLWU PCI) END ; 
T3*p ; 

IF P(WH1»TENCABS(P((E1«-D-T3)*ND*DUP))]*IF PtXCH)>0 THEN 
PCX) ELSE P(/)».T4»ISN)»TENCE1+11 THEN 

BEGIN P(TENCE13».T4»lSD)i E*E + 1 END ) 
PC5); IF D>8 THEN BEGIN E1*T4 DIV T8; D*D*8; PCDEL#0) END ; 
STREAMCSKP«-P>Q*P!D»El,T4»E«-ABS(E + T3)>ES«-E<C-T3),SGN,T2l»BUFF5 J 

BEGIN 

si*T2i; ds+skp chr; maybe(sgn*li» m - h )> ds*lit"."; ci«-ci+q> 
si«-loc ei; ds*d dec; ds^sdec; go l2; sh-loc T4; ds*d dec ; 

L2! 0S*2LIT W E **; CI*CI+ES; GO |_3J DI*OI-i; DS^LIT"-" ; 

L3! DS*2DEC; SKP*DI ; 

END J 
P(BEL) I 
IF SCALE>0 THEN STREAMC SCALE* SKP*SKP+SGN, BUFF ) } 

DPp T kj 

di*di + skp; skp*di; si*skp; si*si+i; ds«-scale chr ; 
end ; 

GO TEST ; 

p(chr*w-d; if prntr then pcdel#w+6) ; 

p(cp(0up). [331123 inx sav8uff )&p( xch ) c 30 ! 45! 3] ) i go test j 

pco) ; 

skip; go testi ; 

output) if (r*r-1)>0 then go ss else go test2 ? 



ELSE 8*T1»T1#BUFF) ; 

os^ti chr; q*di end 



GO Al 
TESTI . 



; 



HHJ 



GGi 



pcwhi»6) ; 
Skip * 

STREAM(Q*P!T<-IF C0DE*6 THEN 2 

BEGIN SK-LQC o; SI*Sl+T; 
GO TEST ; 

P("F")J IF T5 THEN P(29,+); P<1)J 
SCALE*W4FMTHtlUlll3* CHR*C«R"WI GO 
PC 16 55 SKIP i 
STREAMCQ*3x(16-Tl)lTl#HHl#8UFF) i 

BEGIN 

Sl«-L0C WHi; SKIP Q SB i 

T1CDSORESET; 3CIF SB THEN DS«-SET ELSE DS*RESET; SKIP SB}) ; 

Q«-DI ; 

end ; 

GO TEST ; 

PCDEDJ IF <CHR*CHR + R)>MAXCHR THEN GO AWAY ; 

STREAMCQ<-[FMTtFl3]»R,S*R,t36«63*BUFF> i 

BEGIN SI«-Q; Sl«.SI + 3; D5*R CHR; SCDS«-32CHR; 
BUFF<-P; FI«-CR + 2).[36»9]+Fi; GO GETNEXTPHRASE 
IF TYPE = INTEGR THEN BEGIN DECPT*D«-0; GO II END 



0SO2CHR); Qt-DI END ; 



02895110 
02895115 
02895120 
02895125 
02895130 
02895135 
02895140 
02895145 
02895150 
02895155 
02895160 
02895165 
02895170 
02895175 
02895180 
02895185 
02895190 
02895195 
02895200 
02895205 
02895210 
02895215 
02895220 
02895225 
02895230 
02895235 
02895240 
02895245 
02895250 
02895255 
02895260 
02895265 
02895280 
02895320 
02895360 
02895400 
02895440 
02895480 
02895520 
02195560 
02895600 
02895640 
02895680 
02895720 
02895760 
02895800 
02895840 
02895880 
02895920 
02895960 
02896000 
02896040 
02896080 
02896100 
02896120 
02896160 
02896200 



0574!2 
0574!3 
0575*1 
057511 
0576'0 
0576*3 
0578!0 
0580*2 
0581*0 
0582*3 
0586»0 
0586»0 
0588*0 
0588»2 
0592«0 
0595*1 
0598*0 
0602*2 
0606*3 
0606*3 
0609*3 
061113 
061313 
0614*1 
0614*2 
0614*3 
0617*3 
0617*3 
0619*2 
0620*0 
0620*1 
0620*3 
0623*3 
0626*2 
0626*3 
0628*2 
0632*3 
0632*3 
0633*1 
0634*0 
0638*0 
0639*3 

0640*1 
0642*2 
0646*0 
0647*0 
0649*3 
0649*3 
0650*2 
0653*2 
0653*3 
0654*0 
0654*2 
0657*2 
0660*0 
0662*2 
0668*0 



• 



• 



in 

Jj: 
FF* 



IF TYPEsLOGICAL THEN GO 
IF E120 AND El<D THEN 

BEGIN 

W«-W-4? D+D-Et ' 



ll ; 



• 



end; 



ee* 

DDS 

on 






IF 
IF 
IF 

IF 

IF 



J 



IF P(0*E1 + D*DUPX0 THEN PC DEL* WH3*0 ) ; 

IF T4 AND DECPT THEN T6*P ELSE T3«-SETUP + T3 ; 

P<CODE a 9) ; 

E*(T4*IF (ND«-0XE1 THEN El ELSE PCDUP ) XCT5* IF COMMAS THEN 

(T4-1) DIV 3 ELSE 3+DLRSGN+SGN ; 
IF P THEN 

BEGIN IF CCHR*CHR+E-W)>MAxCHR THEN GO AWAY; P(WH3sQ) | 
ELSE IF P(H-D-DECPT-E»OUP)<0 THEN GO 0VRFLW2 ; 
SKP*P+T5 i 
IF El LSS 1 THEN 

BEGIN IF (ND«-CT4*SKP*0)-El)>D THEN ND«-D + T4J SKP*SKP-T4 
GO eONVERT / 
END ; 

p<"e">; go di ; 

PCD") f 

T4 THEN BEGIN P(DEL); GO SE END; IF P( SCALE* DUP )<0 THEN P(DEL*0); 
(SKP*-P( D+P*DUP)+W-5-SGN-DLRSGN)<0 THEN GO 0VRFLW2 * 
D«-SCALE<0 THEN IF -SCAUE2SAVD THfN GO QVRFLW2 ELSE PCSCALE**) 
SETUP THEN P(TENCT3-13, ,WH3* ISO) ; 
CT4*ND*0XSCALE THEN 

BEGIN 

IF ABSCE1«-E1-SCALE)>99 THEN GO OVRFLW1 ; 

IF D THEN ND«--SCALE ELSE T4+SCALE ; 

end ; 

CONVERT: 

IF NOT OBLPREC AND T3>8 THEN 

BEGIN HH3*(WH2*WH3) DIV T8J T3*T3*T2*8 END ; 
STREAM(ND*SKP»T6*S6N*E<-0ECPT*S«-SKP.C36*6 3,T*T6 f C36*6J,DLRSGN*T4, 
T21*WH3#T3*WH2,T2»WH1#T1»BUFF> * 
BEGIN SI*T21; DS«-SKP CHR ; 

SCSI*T2i; DS+32CHR; DS*32CHR); SKP*DI> MAYBECDLRSGN*L3* M $" ) 
MAYBECSGN*Ll*"<- M ); SGN*DI; OI*Dl+EJ NOCDS«-LlT"0 M ) i 
SI<-LOC WH3; OS*T3 DEC! Sl*iOC WH2; DS«-T2 DEC; SI*LOC WHl ; 

ds*ti dec;t6(ds*-lit m o");tc32(ds*2LIT w o m ));nd«-di;ci*ci*e; 
go L2; si«-sgn; dk-sgn; si<-si + i; ds*T4 chr; ds^lit'S"; L2* 
end ; 
T6*p ; 

IF (T4«-P(XCH)XQ THEN 

STREAM(BUFF*P!T4,SGN<-IF El LSS THEN "•» 
BEGIN 

di^buff; si«-iqc ta; si*si+7; ds*-chr; 

ds*2 dec; buff*di ; 

end 

T5>0 THEN 
STREAM(T«-T5-l,Q<-E-T5x4,T5* T6 ) ; 
BEGIN 
SI*T6J DI«-Dl-T5i DS4.Q CHR; DS^LIT"*" 

tcds*3Chr; ds^lit"**) ; 

end ; 

THEN BEGIN BUFF*P; PCW+W-SAVW); GO Xl 



; 



ELSE " M *S«.ABScEl)) ; 

si*si+7; ds«-chr ; 



else if 



IF 
GO 



w*savw 
test ; 



end ; 
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'067l*0 


02896280 


T 


0672*1 


02896320 


T 


0674 SO 


02896360 
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0674*2 


02896400 
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0677*0 


02896440 


T 


0677*0 


02896480 


T 


0677*0 


02896520 


T 


0680*1 


02896600 


T 


0685*0 


02896640 


T 


0685*3 


02896680 


T 


0689*1 


02896720 


T 


0694*0 


02896725 


T 


0694*0 


02896760 


T 


0698*0 


02896800 


T 


0703*0 


02896840 


T 


0704*0 


02896880 


T 


0704*3 


02896920 


T 


07H*0 


02896960 


T 


0711*2 


02897000 


T 


0711*2 


02897040 


T 


0712*1 


02897080 


T 


0712*2 


02897100 


T 


0716*0 


02897120 


T 


0720*2 


02897360 


T 


0724*1 


02897400 


T 


0727*0 


02197440 


T 


0728*3 


02897480 


T 


0729*1 


02897520 


T 


0731*3 


02897560 


T 


07 34*3 


02897600 


T 


0734*3 


02897640 


T 


0734*3 


02897680 


T 


0736*1 


02897720 


T 


0740*1 


02897760 


T 


0744*0 


02897800 


T 


0746*1 


02897840 


T 


0747*0 


02897880 


T 


0750*0 


02897920 


T 


0753*1 


02897960 


P 


0755*0 


02898000 


T 


0759*1 


02898040 


T 


0761*1 


02898080 


T 


0761*2 


02898120 


T 


0762*0 


02898160 


T 


0763*1 


02898200 


T 


0767*1 


02898240 


T 


0767*2 


02898280 


T 


0769*0 


02898320 


T 


0769*2 


02898360 


T 


0769*2 


02898400 


T 


0771*0 


02898440 


T 


0774*2 


02898480 


T 


0774*2 


02898520 


T 


0776*1 


02898560 


T 


0777*3 


02898600 


T 


0778*0 


02898640 


T 


078l*2 



m 
m 
* 






0VRFLW3 

PCD 
0VRPLW2 

PCD 
0VRFLW1 

PCD 
OVRFLW! 

STR 

TEST* 

BUF 
TESTIS 
IF 
TEST2J 
IF 
PC* 
IF 
COD 
END 



J 

ED ; 
i 
el) ; 

I '. . . ■ . . . ■ ■ ■ 

• ■■ ■■■■..■■■ ■ ■ ■ .:■■■■■. 

el) ; 

eamcw*savwjw1«-savw, e3656)#buff) ; 
begin wcds<-lit"*"); wk 32(ds«-2l it"*" ) ) ; 

F*P t 

CR4-R-1)>0 THEN GC REPEAT1 i 



W*Dl END I 



CXTRA AND 3)=0 THEN 

TRA); XTRA*-SAvW<-0 ; 

PCDUP) THEN BEGIN SAVW«-P ., C42 ! 5-11 

EM* R*P.[42»4]; GO SS i 

of ftoutfix ; 



GO GETNEXTPHRASE * 

C0DE*4; 



GO REPEAT2 END I 



02898660 
02898665 

02898680 
02898720 
02898760 
02898800 
02898840 
02898880 
02898920 

02898960 
02899000 

02899040 

02899080 
02899085 
02899120 
02899160 
02899200 
02899240 
02899280 
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T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
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T 
T 
T 
T 
T 



0782*0 
078280 

078211 

0782*1 

078381 
078381 

078481 
078481 

078780 

079082 
079082 

079i*2 

079i!2 
0793 * 3 

0793*3 
079582 

079780 
080280 
080«! 1 



1 
• 



SIZE* 0805 WORDS 



% FORTRAN OUTPUT INTRINSIC 
PROCEDURE FTOUTJ % 051 






COMMENT 



REAL 



ARRAY 
NAME 

REAL 

INTEGER 
REAL 

ARRAY 



NAME 
REAL 



BEGIN 
EILX 
FMTA 
LISX 
EDITCODE 



START OF REL, 



EDITCODE 
FORTERR 

LISX 

FI 

DKADR 

FMTA ~ 

FILX s 

MEM a 
ALGOLWRITE 
SELECT 
LSTRN 
LISTYPE 
ARRAYSTUFF 
TEN 
TPAR 
FIB[*J8 

listadr; 

BUFF 

BSlZE 

FLG 



FILE TOP 10 DESCRIPTOR 
FORMAT OR NAMELIST OR 
ACCIDENTAL ENTRY DESCi OR 

NO FORMAT. NO LIST 

1 FORMAT* NO LIST 

2 NO FORMAT* LIST 

3 FORMAT* LIST 

4 NAMELIST 

; 



-l* 

24* 
-2* 

-4* 

-5; 

-3[*]* 
"6* 
2; 

■ 12* 



FP8 .* 31*] ; 



14; 
19; 

20* 

is; 

22C*3* 
23C*3* 



* % TRUE 



* 3! FIRST BUFFER POSITION 

* % ARGUMENTS 
FOR SERIAL I/O 



02900000 
02900100 

segment; disk 

02900200 
0290030Q 
02900400 
02900500 
02900600 
02900700 
02900800 
02900900 
02901000 
02901100 
02901200 
02901210 
02901300 
02901400 
02901500 
02901600 
02901700 
02901800 
02901900 
02902000 
02902300 
02902400 
02902500 
02902900 
02903000 
02903100 
02903200 
02903300 
02903400 
02903410 



T 000080 
T 000080 
ADDRESS -m §0377 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



000080 
000080 
000080 
000080 

000080 

000080 
000080 
000080 
0000 8 

000080 
000010 
000080 
0000*0 
000080 

ooooto 

000010 
0000*0 
000080 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 



ARRAY 
INTEGER 



• 



BOOLEAN 



* BUFFt*3; 



• 



WH1» 

WH2 

Wl 

W2 

NFCI 

IOBUFF 

DHl 

DH2 

OH3 

RPT 

W 

WT 

Tl 



OT 

Dl 

02 

03 

ZEROS 

OR 

SHFT 

COOE 

SKP 

NCR 

LCR 

QUOTE 

OHR 

PRCW 

PCT* 

PS 

DONETOG 

SGN 
PRNTR 
FMERRTOG 
LGTG * 
OTOG 
CTOG 
GTOGA 
GTOG 
DEFINE DBLV = 5#, 
CMPLXV = b«, 

GTYPE = 1## 

rTYPE * 2#* 

ETYPE ■■ 3#, 

DTYPE a 4#» 

ITYPE = 5** 

L.TYPE = 6#> 

ATYPE - 7$, 

OTYPE - 8#* 

KINO = CFIB[<t3.C8l4])#j, 

TAPEF «2#* 

MAX = ?7777777777777*# 

OLN = (LISTYPE,C44S43 

CMPIX = (LlSTYPE.Cfl«U3 

TWOO * LlSTYPE,C38»U## 

LPPS = 15 » 30 * 1 8# * 

LPPR = C 15 S 18 ] ## 



% 

% 

% 
% 
% 



% 
% 
% 
% 
% 
% 
% 
% 
% 
% 



% 
% 



PAREN 
PAREN 



•% TRUE 



CONTROL 
COUNTER 

; % 

, % 

, % 

IF 



NEXT FORMAT CHAR LOCATION 

CONV- 
ERTED NU- 
MBER 
REPEAT INDICATOR 
FIELD 

WIDTH 

DEC- 
IMAL P- 
LA- 
CE- 
S 
TRAILING ZEROES 
EXPONENT 

INTEGER PART OF SHIFT 
EDITING FUNCTION 
REDUNDANT POSITIONS 
CURRENT BUFFER POSITION 
BUFFER SIZE IN CHARACTERS 
STRING DELIMITER C« OR 0) 
CURRENT CHAR FROM FORMAT 
WORD 



scale factor 
Return after 

SIGN 
PRINTER OUT PUT 
% FORMAT ERROR 



WRITE 



* DOUBLE PRECISION TOG 
% COMPLEX NUMBER TOG 

% G EDITING TOG W-0 - SGN 
% G EDITING TOG 



> 4 



=DBLV)#> 

a CMPLXV)#i 



02903500 
02903600 
02903700 
02903800 
02903900 
02904000 
02904100 
02904200 
02904300 
02904400 
02904500 
02904600 
02904700 
02904800 
02904900 
02905000 
02905100 
02905200 
02905300 

02905400 
02905500 
02905600 
02905700 
02905800 
02905900 
02905910 
02906000 
02906010 
02906020 
02906j00 

02906200 
02906300 
02906400 
02906500 
02906600 
02906700 
02906800 
02906810 
02906900 
02907300 
02907400 

02907500 
02907600 
02907700 
02907800 
02907900 
02908000 
02908100 

02908200 
02908300 

02908500 
02908700 
02908900 
02909000 
02909100 
02909200 
02909300 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
000010 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 

ooooso 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 






• 
• 



LABEL 



RPTF 
NORF 
PCF 
ENDLIST 
SIZEF 
BASEF 



< 0)#* 



* * 



* * 



= C 33 s 153#* 
- (P(XCH*DUP) 
* £956]#, 

= CLSTRN a (-1))#* 

* [33*153*, 

* C 18S 153#; 

typerr,nmlst, 

strt*repeat^lpar*rtpar*slash^string#tfmt»fmterr» 
cl1#cl2,cl3#cl4,scal*h0l,skip,cl3a,stra,tfma,tix, 
eRtn,g»f*e#oc»i#l#a*aa*o»fa»ga>ast#comm, 
nofl>fnol»binary»fmtlstf 
fRmtcD»nfph,fmcyc,fmerr*zap,zipit; 
comment ***** start of subroutine declarations * # * 

SUBROUTINE CKPb; 
BEGIN COMMENT INITIALIZE FILE AND ACQUIRE RECORD SIZE; 
LCR «• SxCBSIZE <• P (MKS#FLG» DKADR> 0* C- 1) , FILX» ALGOLWRlTE ) )| 
IF PRNTR*PRNTR&{C(T1*FIBU].C8I43)*1 OR Tl=7 OR Tl»l2) AND FPBCFIBC43 
.[131 11] +3 3. [43: 5]<20)C 47:47! 1 3 THEN 
IF 8SIZE > 17 THEN BEGIN LCR «• 132; BSIZE ♦• 17 END; 
BUFF«.(IF T1«-PRNTR AND (EDITC0DE*1 OR E0lTC0DE>2) THEN TPAR ELSE *FlLX) 
.[33*15] ; 

IF ((NOT Tl) OR PRNTR.[46:iJ) AND EDITC0DE*2 THEN 
STREAM(P2 <* (BSIZE-1). [36:6]^ 

P3«-BSIZE + T1-1*P4*BUFF) ; 
BEGIN DI * P4; DS «■ 8 LIT " "; 

Si * pa; 

P2CDS ♦- 32 WDS; 

DS «• P3 WDS; 

end; 

NCR <■ Oj 
END CKPB/ 

subroutine prnt; 

begin comment generate 

if prntr and (editcode * 1 

begin; 

NCR * O; 

STREAM(P1*0:P2«-TPAR); 
BEGIN SI *P2; DI * LOC 



DS * 32 WDS); 



A CALL FOR CAR, CONT, AND FOR OUTPUT; 
OR EDITCODE > 3) THEN 



pi; di *di 



7; ds *chr; 
di «• P2; ds f. lit " m ;e 
ncr * p; 

if ncr ■ " »' then d2 «• 16 else 
if ncr - "0 m then d2 ♦ 32 else 
if ncr « «+" then d2 «• else 

if (02 «• ncr) > 9 then 02 * 16; 
if not prntr. [4611] then fibc 173«-fib[ 17 3+bsize ; 

PCMKS*D2.[42*23,D2,U4U]#PRNTR,C46I1]#BSIZE*FILX#ALGQLNRITE> ; 
FIB[63*FIBC63-(D2=0) ; 

IF NOT C *FILX 3 • C 191 X 3 THEN P(FlLX,?2000000000*2>COM, DEL#DEL ) ; 
PRNTR*»i; gkpr ; 

STREAM(P1«-TPAR^P2«-*FILX*P3*BSIZE,[36 8 6 3»P4«.8SIZE); 
BEGIN 

si *■ pi; di «- P2; ds «■ P4 wds; 
p3(ds *32 wds; os <• 32 wds); 
di<-pi; p4(Ds*-8lit m ") ; 

end; 
fibc17]<-flr[17]-8size; if donetog then pcxit) ; 

end else begin pc mks,flg*dkadr,0> bsi ze*filx, algolwrlte > ; 



02909400 
02909500 

0g9095l0 

02909600 

02909700 

02909000 

02910000 

02910100 

02910200 

02910300 

02910400 

02910500 

02910600 

02910700 

02910800 

02910900 

02911000 
02911005 
02911010 
02911100 
02911200 
029M400 
02911500 

02911600 
02911700 

02911800 
02911900 
02912000 
02912100 
02912300 
02912400 
02912500 
02912600 
02912700 
02912800 
02912900 
02913000 
02913100 
02913200 
02913300 
02913400 
02913500 
02913600 
02913700 
02913900 
02914000 
02914010 
02914100 
02914200 
02914300 
02914400 
02914500 
02914600 
02914610 
02914700 
02914800 
02914900 



T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 

ooooto 

0000?0 
0000*0 
0000*0 
0000*0 
OOOO'O 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 

0001*0 

0001*0 

0004*2 
0009*0 

0013*0 
0016*1 
0020*2 
0022*0 
0024*2 

0026*2 
0028*1 

0029*3 
0030*0 
0031*1 
003U3 
0032*0 
0032*3 
0033*0 
0033*0 
0033*0 
0035*1 
0035*3 

0036*2 
0038*0 
0039*0 
0040*0 
0040*2 
0042*2 
0045*0 

0047*2 
0050*2 
0054*0 
0057*1 
0059*3 
0063*0 
0065*0 
0067*2 
0067*2 
0068*2 
0069*3 

0072*0 
0072*1 

0075*1 













• 



• 



• 



IF DONETOG THEN P(XIT)J 

CKPB END f 
END PRNT; 
LABEL NFCLI 
REAL SUBROUTINE NFC* 
BEGIN 

NFCL* 

WHILE NFCI.C45I3] < 2 DO NFCI * NFCI + it 
STREAMfPl *■ OJP2 <-FMT A t NFC I . C 30 : 15 3 3 > P3 * NFC I . f 45 J 3 3 )} 
BEGIN DI * LOC PI; OS * 7 LIT "0"; 

si «■ loc P2; si *si + Psios * chr; 

SI * SI - li DI * DI - 1* 

end; 

NFCI <- NFCI + l; IF (CHR *■ p } * » h THEN IF NOT LGTG THEN GO NFCL; 

nfc «• chr; 

END NFC; 
SUBROUTINE 1ST; 
BEGIN ; 

STREAVCPl «• D'rp2 *■ 8UFF*P3 ■* CHR>; 
BEGIN SI <- LOC P3; SI * Si + 7i 

di * P2; ds * chr; pi «■ di; 
end; 
buff * p; 

END 1ST; 

% parameters for list control 
boolean atog*twdt; 
array ar1 » listadrc*]; 
real indx,size>nli>nle; 

LABEL RTNLSTfSRT; 

DEFINE NXTELM = IF TWOT THEN PC*CARl C INDX. C 3317] ]J» INDX, C40'»8J*C0C) 

ELSE AR1CINDX]#; 
SUBROUTINE GETLlST; 
BEGIN 

SRT: IF ATOG then 
BEGIN 

IF DLN THEN 
BEGIN 

WHl <■ NXTELM; 
INDX <• INOX + i; 
WH2 *• NXTELM; 
END ELSE 
BEGIN 

WHl «• NXTELM; 
WH2 * 0* 

end; 

IF (INOX <-IN0X + 1) i SIZE THEN 
BEGIN 

ARRAYSTUFF <• o; 

atog «- false; 
end; 

go to rtnlst; 
end; 

if ctog then 
begin % imaginary part of complex 

WHl * listadrch; 

whs *• o; 

CTOG «- FALSE; 



02915000 
02915100 
02915200 
02915300 
02915400 
02915500 
02915600 
02915700 
02915800 
02915900 
02916000 
02916100 

02916800 

02916900 

02917000 

02917100 

02917200 

02917300 

02917400 

02917500 

02917600 

02917700 

02917800 

02917900 

02918000 

02918100 

02918200 

02918400 

02918500 

02918600 

02918700 

02920200 

02920300 

02920400 

02920500 

02920600 

02920700 

02920800 

02920900 

02921000 

0292HOO 

02921200 

02921300 

02921400 

02921500 

02921600 

02921700 

02921800 

02921900 

02922000 

02922100 

02922200 

02922300 

02922400 

02922500 

02922600 

02922700 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 



0078*3 
0079*3 
008i»0 
008H1 
008l«l 
0082*0 
0082*0 
0082*0 
008552 
0088*1 
0089^3 
0090*3 
Q09l«l 
0091*2 

0095*0 
0095*2 
00951 1 3 

0096*0 
0096*0 
0097*2 
0098*0 
009853 
0099*0 
0099*2 
0099*3 
0099*3 
0099*3 
0099*3 
0099*3 
0099*3 
0099*3 
0099*3 
0100*0 
OlOO'O 
0100*1 
0100*3 
0102*0 
0102*2 
0107*0 

0108*1 
0112*3 

0112*3 
0113*1 
0117*3 
0118*2 
0118*2 
0120*1 
0120*3 
0121*2 
012211 
0122*1 
0122*3 
0122*3 
0123*0 

0123*2 
0125*0 
0125*3 



i 



• 







END. 



GO TO rtnlst; 

PCOJJ LISTADR 
IF ARRAYSTUFF * 



• CUISX3 ^ 

THEN 



BEGIN 



ATOS *■ TRUE/ 

SIZE*f I NOX* ARRAY STUFF, BASEF) + ARRAYSTUFF, SIZEF } 

THDT*NOT PC*(LlSTADR«-MEM[LlSTADR.C18S15]])*T0P>i 

go to srt; 



PCDEL) I 



end; 



p(ded; 

WHl «■ LISTADRCO]; 

WH2 «■ IF DIN THEN LISTADRClJ ELSE Of; 
CTOG <• CMPLX; 
RTNLST? 

end getlist; 

SUBROUTINE FORMATCaNTRaL * 
BEGIN 

STRT* 

w«-d«-cgde<-skp*-rpt*o; 
sgn«-donetog*fmerrtog*false; 
clls comment check for single character editing types; 
nfc<9 then go to repeat; % must be repeat 
chr m "<" or chr * ■■"*" then go to lpar; 



IF 
IF 
IF 
IF 
IF 
IF 



FIELD 



CHR = w >" OR 

CHR = 'V« THEN 
CHR ■ »"» OR 
CHR="T" THEN 

SGN«-CCHRs"-") & 

IF SGN THEN 



chr » "c" then go to rtpar; 
go slash; 

chr ■ "3" then go to string; 
go to tfmt; 

(CHRa"+")[2J47! 



13 



BEGIN 



IF NFCS9 



THEN 
ELSE 



GO 
GO 



TO 
TO 



REPEAT 

fmterr; 



end; 



IF CHR«"#" 
RPT+1* 



THEN GO TO STRt; 



CL25 



CL3 



COMMENT TYPES WHICH MAY HAVE REPEAT FIELDS; 

IF SGN THEN RPT**RPT; 

IF CHR*"P" THEN GO TO 

IF RPT<0 OR SGN.C2U3 

IF CHR = "<•» OR CHR * 

IF CHR«"H W THEN GO TO 

IF RPT*0 THEN RPT*W 

IF CHR a "X" THEN GO TO SKIP; 

COMMENT TYPES WHICH HAVE W FIELDS; 

IF CHR«"I W THEN CODE ♦ ITyPE ELSE 
IF CHR=«A" THEN CODE * ATYPE ELSE 



SCAL* 

THEN GO TO FMTERR; 

"%" then go to lpar; 
hol; 



IF CHRa"L" THEN CODE * LTYPE ELSE 
IF cHRs'»0" THEN CODE «■ OTYPE; 

if code > itype then go to cl3a; 
cl^s comment types with n and d fields; 

if chr= m d" then code * dtype else 
if chra»e" then code ♦ etype else 
if chrs»f» then code * ftype else 
if chr*"g" then code «- gtype else 
go to fmterr; 
cl3aj comment develop value of w field; 



02922800 
02922900 

02923600 
02923800 
02923900 
02924000 
02924400 
02924500 
02924600 
02924700 
02924800 

02924900 
02925000 
02925100 
02925200 
02925300 
02927400 
02927500 
02927600 
02927700 
02927800 
02927900 
02928000 
02928100 
02928200 
02928300 
02928400 
02928500 
02928590 
02928600 
02928700 
02928800 
02928900 
02929000 
02929100 

02929200 
02929300 
02929400 
02929500 
02929600 
02929700 
02929800 
02929900 
02930000 
02930100 
02930200 
02930300 
02930400 
02930500 
02930600 
02930700 
02930800 
02930900 
02931000 
02931100 
02931200 
02931300 



0126*2 
012710 

0127*0 
0128«0 
0128*3 
0129*1 
0130*0 
0132*3 
0136*1 
0136*3 
0136*3 

0137*0 
0137*3 
0141*3 
0143*2 
0143*2 
0143*3 
0144*0 
0144*0 
0144*0 
0146*3 
0148*2 
0148*2 
0151*0 
0153*2 
0156*0 
0157*1 
0159*3 
0161*0 
0163*3 
0164*0 
0164*2 
0166*2 
0167*2 
0167*2 
0168*3 
0169*2 
0169*2 
0X7 HI 
0172*2 
0175*0 
0177*2 
0178*3 
0180*3 
0182*0 
0182*0 
0184*0 
0186*2 
0189*0 
0191*2 
0192*3 
0192*3 
0194*3 
0197*1 
0199*3 
0202*1 
0202*1 



• 

# 
# 



m 



IF NFC>9 THEN GO TO FMTERRJ 
W<-CHR; 

WHILE NFC$9 DO W*lOxW+CHR; % CONVERT TO OCTAL 
NFCI«-NFCI-i; 

IF W>63 THF.N GO TO FMTERR; 
IF CODE>ITYPF THEN 60 TIX; 
COMMENT DEVELOP D FIELD* 

IF NFC*»." THEN GO TO FMTERR; 

if nfc >9 then go to fmterr; 
d«-chr; 

WHILE NFCS9 DO D«-i0xD + CHR; % CONVERT TO OCTAL 

NFCI*NFCI-i; 

GO TO TIX/ 
LPAR! COMMENT GENER1TE PAREN CONTROL WORD; 

IF PCTXO AN D RPT«?0 THEN RPT*1 I 

Tl <■ RPT«NFCItLPPS]*(RPT<0)tl«47llj; 

IF PCT < 1 THEN PRCW * Tl & PCTC9;42?6i; 

P (Tl* XCH); pct«-pct+i; 

go to strt; 
rtparj comment point at left par if repeat not exausted; 

if norf then 
begin % no repeat field 

donetog «■ endlist; 

prntu write out recorq 

if (pct ♦ pct - 1) < then if prcw.pcf po 
then begin p(xch,prcw)j pct * 2 end else pct <• 1* 

END ELSE 
BEGIN 

• IF (RPT«.p(DUP),RPTF) < 1 

THEN BEGIN P(DEL)*PCT * 

ELSE P(RPT 



end; 



- 1'CCX); 

,LPPR; % RESET TO 



PCT - i; GO TO STRT END 



LEFT PAREN 



REPEAT! 



SLASH? 



STRING 



STRA 



TPMTs 



nfci«-p(dup> 
pcxch); 
go to strt; 
comment convert repeat field to octal in rpt; 

RPT*CHRI 

WHILE NFCS9 DO RPT«- 10*RPT+CHRJ 
GO TO CL2; 

comment write out buffer; 

prnt; 

go to strt; 
comment move string from format array to buffer; 

quote ♦ chr; % save strlng delimiter 

lgtg * true; chr * nfc; 

if (ncr * ncr + 1) > lcr then go to fmterr; 

1ST; 

then go to stra; % « or p 

go to strt; 
to character position indicated by field 



TFMa* 



IF NFC f QUOTE 

LGTG * FALSE ; 

COMMENT SET BUPFER 

FOLLOWING "T"J 
IF (RPT*-NFC)>9 
WHILE NFC<9 DO 
IF RPT>LCR THEN 
NCR*-RPT-5,; 
RUFF *- C C I F PRNTR THEN TPAR ELSE 
NCR,C33:123)&NCR[30:a5»33; 



then go to fmterr; 
rpt«-ioxrpt+chr; 
go to fmterr; 



(*FILX)) INX 



02931400 


T 


020211 


02931500 


T 


0204*0 


02931600 


T 


0204*3 


02931700 


T 


0209?! 


02931800 


T 


0210*2 


02931900 


T 


021113 


02932000 


T 


0213«0 


02932100 


T 


0213*0 


02932200 


T 


0215*0 


02932300 


T 


021710 


02932400 


T 


021713 


02932500 


T 


0222*1 


02932600 


T 


0223*2 


02932700 


T 


022410 


02932710 


T 


0224*0 


02932800 


T 


0227*0 


02932810 


T 


0230?! 


02932820 


T 


0233*1 


02932900 


T 


0235*0 


02933000 


T 


0235*2 


02933100 


T 


0235*2 


02933200 


T 


0236*2 


02933300 


T 


0237*0 


02933400 


T 


0238*2 


02933410 


T 


0240*0 


02933420 


T 


0243*0 


02933500 


T 


0246*2 


02933600 


T 


0246*2 


02933700 


T 


0247*0 


02933800 


T 


0248*1 


02933900 


T 


0251*1 


02934000 


T 


0252*3 


02934100 


T 


0252*3 


02934200 


T 


0254*0 


02934300 


T 


0254*1 


02934400 


T 


0254*3 


02934500 


T 


025413 


02934600 


T 


0255*2 


02934700 


T 


0260*1 


02934800 


T 


0260*3 


02934900 


T 


0260*3 


02935000 


T 


0262*0 


02935100 


T 


026212 


02935110 


T 


0262*2 


02935200 


T 


0263*1 


02935300 


T 


0265*2 


02935400 


T 


0267*3 


02935500 


T 


0269*0 


02935600 


T 


027l*0 


02935700 


T 


0272*1 


02935800 


T 


0272*1 


02935900 


T 


0272*1 


02936000 


T 


0274*2 


02936100 


T 


0279*1 


02936200 


T 


0280*2 


02936300 


T 


0281*3 


02936400 


T 


0284*0 







GO TO STRTj 
SCAL« COMMENT SCALE FACTOR OF P PHrASf; 

ps*rpt; 
go to strtj 
holt comment hollerith string; 
lgtg <• true; 
while r pt > do 

BEGIN 

IF (NCR *■ NCR + 1) > LCR THEN GO TO FMTERR; 
CHR *■ Npc; 1ST; 

rpt+rpt-i; 



SKIP 



end; 

LGTG ♦ FALSE; 

comment x phrase; 



if (ncr * ncr+rpt) 
go to tfma; 

FMTERR! FMERRTOG^TRUE; 



go to strt; 

> lcr then go to fmterr; 



TIXJ 

end formatcontrol; 
subroutine funnyzerq; 

BEGIN 

SKP *• W - (D + 6 + SQN); 

STRIAMCP1*- BUFF SP2*SKP*P3«-SGN«p4«- (0*4)); 

BEGIN 

di *pij di ♦ oi ♦ ps; 

P3(DS <■ LIT »-«; JUMP OUT TO l)J 
DS «• 2 LIT "0,"J 
P4(DS <■ LIT " •'); 



L* 



PI 



DI 






end; 
buff «. p; 

END FUNNYZERO; 
SUBROUTINE FINDE; 
BEGIN IF DTOG THEN 

DOUBLE(TEN[0]#0#WHl*WH2#x,«-,wHl»HH2) 

ELSE WH1 * TENC03 x HHU 
EXP«-(0&WH1C 42 : 3 *6 J&WHH 1*2* 13 + 12. 5 )x. 90308998709 ; 

¥2 *■ o; 

IF DTOG THEN 

IF EXP > THEN D0UBLE(TENCEXP3 ,TENE 69+EXP ] , *, W 1 * W2) 

ELSE DOUBLE CI * 0* TEN C -EXP-]* TEN [69«-EXPW»«-»iU*W2) 
ELSE Wl ♦ IF EXP > THEN TENEEXP3 ELSE 1/TENC-EXP3; 
IF WH1 > Wl THEN GO TO ERTN; 
IF WH1 * Wl THEN 

IF WH2 > W2 THEN GO TO ERTN; 

EXP «• exp-i; 
ERTn: 
end finde; 
subroutine numconvert; 

BEGIN 

IF DI > THEN 
BEGIN 

D0lJBLECWHl#HH2#TENCi6J,TENC853»/,«.»Wl#W2); 
DH1 <■ Wl DIV 1,0; 

end; 

IF D2 > THEN 
BEGIN IF DTOG THEN 



02936500 
02936600 
02936700 
02936800 
02936900 
02937000 
02937100 
02937200 

02937300 

02937400 

02937500 

02937600 

02937700 

02937800 

02937900 

02938000 

02938100 

02938200 

02938300 

02938400 

02938500 

02938600 

02938700 

02938800 

02938900 

02939000 

02939100 

02939200 

02939300 

02939400 

02939500 

02939600 

02939700 

02939800 

02939900 

02940000 
02940100 

02940150 
02940200 
02940300 
02940400 
02940500 
02940600 
02940700 
02940800 
02940900 
02941000 
02941100 
0294J200 
02941300 
02941400 
02941500 
02941600 
02941700 
02941800 
02941900 
02942000 



T 


028612 


T 


0287*0 


T 


028710 


T 


0287;3 


T 


0288*1 


T 


0288*1 


T 


0289*0 


T 


0290»1 


T 


0290*1 


T 


0292*2 


T 


029fit0 


T 


0297*1 


T 


0297*3 


T 


0299*0 


T 


0299*0 


T 


0301*1 


T 


030i*3 


T 


0302*2 


T 


0302*2 


T 


0302*3 


T 


0303*0 


T 


0303*0 


T 


0305*1 


T 


0307*2 


T 


0307*2 


T 


0308*1 


T 


0310*0 


T 


0310*2 


T 


0311*3 


T 


0312*0 


T 


0312*1 


T 


0312*3 


T 


0313*0 


T 


0313*0 


T 


0313*1 


T 


0316*1 


T 


0318*2 


T 


0322*1 


T 


0323*0 


T 


0323*1 


T 


0327*2 


T 


0334*3 


T 


0339*2 


T 


340*3 


T 


0341*2 


T 


0343*1 


T 


0344*2 


T 


0344*2 


T 


034413 


T 


0345*0 


T 


0345*0 


T 


0345*3 


T 


0346*1 


T 


0349*1 


T 


0350*2 


T 


0350*2 


T 


035i»i 



i 

i 
i 



• 
• 



• 



• 



BEGIN 

D0UBLE(WHl>WH2>DHl>0#TENi;i6]#TEN[85 3*x,-# 
TENC 83»TENC77]#/,*,W1#W2)J 

0H2 * Wi Olv 1; 
END 

ELSE DH2 «■ WHl OIV TEN[83; 

end; 

if dtog then 

DPr>|(L| 

DOUBLECWHl»WH2>DHi>0#TENtl63#TEN[853#x, 

DH2'0*TEN[ 8 3 *TEN[ 77 3 * x, + ,-, «.,W1, W2 ) ; 
DH3 * Wl oiv 1; 

END 

ELSE DH3 * WHl DlV 1) 

EXP «■ exp + i; 
END NUMCONVERTI 

SUBROUTINE SETO* 
BEGIN 

IF DLN AND DT > 23 THEN 
BEGIN 

ZEROS*DT«23; DT * 23) Ol «■ 7) D2 * D3 «■ 8i 
END ELSE IF DT>12 AND NOT DLN THEN 
BEGIN 

ZEROS*DT-12; DT * 12; Dl+OJ 02 ♦• 4; D3 «• 8; 
END ELSE IF DT>16 THEN 
BEGIN 

Dl+DT-16; D2«-D3*8; 
END ELSE IF DT > 8 THEN 
BEGIN 

Dl*0/D2«.0T-8* 03*8' 
END ELSE 
BEGIN 

di«-D2<-Q;d3«-dt; 
end; 
end setd; 

subroutine rndoff; 
begin if dtog then 

IF Tl 2 THEN 
00U8UE(HHl#WH2#»5»TEN[Tl]#TENCTl- + 69]»x,+,*,WHl#HH2> ELSE 
DOUBLE C WHl »HH2»> 5* TENC -Tl 3, TEN [69-T13 ,/> + >*■> WHl ,WH2) 

ELSE WHl * WHl + (IF TUO THEM SxTENCTU ELSE 5/TENt*T13)i 
END rndoff; 

SUBROUTINE SCAUE; 
BEGIN IF DTOG THEN 

BEGIN IF Tl * 

THEN D0UBLECWH1jWH2*TENCT13,TENCT1+69 3,x,«.,WH1#WH2) 
ELSE DOUBLE CWHUWH 2, TEN C-T13* TEN C69-Tl]»/#*»HHi,WH2); 
IF WHl > TENCDT3 THEN 
BEGIN 

exp * exp + t; 

DOUBLE CHHl#WH2*TENCn#0*/,*,WHl#WH2) J 
END 
END ELSE WHl * IF Tl. I THEN WH1xTfN[T13 ELSE WHl /TENC-Tl 3 ; 

End scale; 

%**•*********** START OF EDIT-CONTROL*****************! 
SUBROUTINE CONVERT; 
BEGIN 



02942100 T 
02942200 T 
02942300 T 

02942400 T 
02942500 T 
02942600 T 
02942700 T 
02942800 T 
02942900 T 
02943000 T 
02943100 T 
02943200 T 
02943300 T 
02943400 T 
02943500 T 
02943600 T 

02943700 T 
02943800 T 

02943900 T 
02944000 T 
02944100 T 
02944200 T 
02944300 T 
02944400 T 
02944500 T 
02944600 T 
02944700 T 

02944800 T 
02944900 T 
02945000 T 
02945100 T 
02945200 T 
02945300 T 
02945400 T 
02945500 T 
02945600 T 
02945700 T 
02945800 T 
02945900 T 
02946000 T 
02946100 T 
02946200 T 
02946300 T 
02946400 T 
02946500 T 
02946600 T 
02946700 T 
02946800 T 
02946900 T 
02947000 T 
02947100 T 
02947200 T 
02947300 T 
02947400 T 
02947500 T 
02947600 T 
02947700 T 



35210 
0352;2 
0355*1 
357*3 
0359*0 
0359»0 
0362*2 
0362J2 
0362*3 
0363*1 
0365*3 
0369*1 
0370*2 
0370*2 
0372*1 
0373*2 

0373*3 
0374J0 

0374*0 
0376*1 
0376*3 
0380*3 
0383*2 
0384*0 
0388*1 
0389*2 
0390*0 

0392*2 
0393*3 

0394*1 
0397*0 
0397*0 
0397*2 
0399*2 
0399*2 
0399*3 
0400*0 
0400*1 
0401*2 
0406*1 
0411*0 
0416*0 
0417*0 
0417*0 
0417*1 
0418*0 
0422*1 
0426*3 
0427*3 
0428*1 
0429*2 
0432*1 
0432*1 
0437*1 
0437*2 
0437*2 
0438*0 



13 

• 



n 






• 



DTQG ♦■GTOG 
SGN <-WHi,[l: 

OH1 «- 
GO TO 



< LTYPE THEN 
♦•EXP * SKP ♦ 



♦ FALSE/ 

n; if code 

DH2 * DH3 <- ZEROS 

P(CODE*OUP^ADD); 

FMERR; 

g; 
f; 
ti 

Oct 

i; 

U 

a; 
o; 

COMMENT OCTAL CONVERSION 
IF W > 16 THEN SKP ♦ 
STREAMCP1 «■ BUFF5P2 * WHi#P3 «- 
BEGIN SI «- LOC P2/ 01 *■ Pit 

DI * DI + P3i P5CSKIP 
P4(DS * 3 



WHl * ABSCWH1); WT * Wl DT 
SHfT * DI * 02 * D3 * O; 



GO 
GO 
GO 
GO 
GO 
GO 
GO 
GO 

GO 

0! 



TO 
TO 
TO 
TO 
TO 
TO 
TO 
TO 
TO 



w 



* * * 

- (WT 
SKP,P4 



* # * 

16); 

WT*P5 



«• 16-WT)i 



Reset; 3(IF 



3 SB); 

SB THEN OS * 
ELSE DS «- 



SET 

reset; 



SKIP SB)); 



PI * 01; 
end; 
buff «• p; 
go to cdmm; 
a* comment alpha 
if w > 6 then skp 

AA? STREAMCPl «• 
BEGIN DI * Pi; 

SI * LOC P2; 
DS * P4 chr; 

end; 
buff * p; 
go to comm; 

L* 



conversion * * * 
* W - (WT * 6); 
BUFf:P2 «■ WH1#P3 
01 * DI + P3; 

SI * SI + 

pi * di; 



«• SKP* P4 * WT); 



II 



comment logicial conversion; 
if w >1 then skp*w-(wt*1)| 

WHl* OS(IF WHl THEN h T« ELSE 

go to aa; 
comment integer conversion; 

IF WH1 = AND WH2 = Q THEN DT * D3 * 1 ELSE 
BEGIN IF DTOG THEN 

DOUBLE (WHl>WH2>#.5>+*«-,WHl>WH 2) 
ELSE WHl * Tl '«- WHi; 

IF WH1«0 AND WH2*0 THEN ExP*-l ELSE 
EXP < THEN DT * D3 «• 1 ELSE 



BEGIN 



end; 
end; 



IF 

I 
IF 

or 



"F")[12!42»6i; 



% ROUND OFF 



FINOE 



(dln and exp>24) or (not dln 
«■ exp+i; setd; numconvert; 



AND EXP>12) THEN GO AST; 



STREAM(P1*0!P2 
P6 
BEGIN 



IF DT + SGN > W THEN GO TO AST) 
IF W > DT + SGN THEN SKP * W - OT 
*■ D1>P3 * DH1,P4 «• D2>P5 * 0H2, 
* D3,P7 «- DH3#P8 * SGN>P9 «• S«P#P10 «■ 

di * pio; p9(di * di ♦ n; 

P8(DS * LIT »♦«-»); 

si *loc pa; os * P2 dec; 

SI * LOC P5; DS * P4 DEC; 



- sgn; 
buff); 



02947800 


T 


043850 


02947900 


T 


0439J1 


02948000 


T 


044M1 


02948100 


T 


0449*2 


02948200 


T 


0450«2 


02948300 


T 


045110 


02948400 


T 


0451*2 


02948500 


T 


0452*0 


02948600 


T 


0452»2 


02948700 


T 


0453*0 


02948800 


T 


0453*2 


02948900 


T 


0454*0 


02949000 


T 


0454*2 


02949100 


T 


0455*0 


02949200 


T 


0455*0 


02949300 


T 


0458*0 


02949400 


T 


0460*2 


02949500 


T 


0461*0 


02949600 


T 


0462*2 


02949700 


T 


0464*1 


02949800 


T 


0465*2 


02949900 


T 


0465*3 


02950000 


T 


0466*0 


02950100 


T 


0466*2 


02950200 


T 


0467*0 


02950300 


T 


0467*0 


02950400 


T 


0470*0 


02950500 


T 


047JS3 


02950600 


T 


0472*2 


02950700 


T 


0473*0 


02950800 


T 


0473*3 


02950900 


T 


047<»*0 


02951000 


T 


0474*2 


02951100 


T 


0475*0 


02951200 


T 


0475*0 


02951300 


T 


0478*0 


02951400 


T 


0481*1 


02951500 


T 


0481*3 


02951600 


T 


0481*3 


02951700 


T 


0485*1 


02951800 


T 


0486*0 


02951900 


T 


0488*3 


02952000 


T 


0492*1 


02952100 


T 


0497*0 


02952200 


T 


0499*2 


02952300 


T 


0500*0 


02952400 


T 


0505*2 


02952500 


T 


0509*0 


02952600 


T 


0509*0 


02952700 


T 


0509*0 


02952800 


T 


0510*3 


02952900 


T 


05H*1 


02953000 


T 


0516*0 


02953100 


T 


0517*2 


02953200 


T 


0518*3 


02953210 


T 


0520*0 


02953300 


T 


0520*3 



• 



• 



m 



€ 



si 

PI 



LOC 
DU 



P7; ds * P6 dec; 



end; 

BUFF ** Pi 
GO TO COMM. 



DC? 

E: 



• 
• 



COMMENT DOUBLE PRECISION CONVERT, SAME AS E CONVERT; 
COMMENT E CONVERSION; 

DTOG * true; 
setd; 

IF WHl s O AND WH2 » THEN 
BEGIN 

IF W < (0+6+ SON) THEN 

FUNNYZERO; GO TO COMM; 
END ELSE 
BEGIN 

finde; 

if ps < o then 



GO TO AST; 



BEGIN 

IF 
IF 
Tl 

END ELSE 

BEGIN 

DT 



cskp *- w - d - 5 - sgn) < then 
cot *• dt + ps) < then dt «• 0; 
♦• exp - dt; rnoQff; 



go to ast; setd; 



DT + (SHFT * ps>; setd; 

exp - dt; rndoff; 



Tl 

IF W<(Tl«-DT + 5 + 

skp+w-ti; 



SGN + ZEROS) 



THEN GO TO AST; 



end; 



scale; 



T1+-DT-1-EXP; 

numconvert; 
exp*exp-ps; 
end; 

STREAMCP1 * 0SP2 * SKP,P3 «- SGN,P4 
P6 * D2,P7 <- DH2*P8 «■ D3> p 9 
Pll * (EXP < 0),P12 «■ 
BEGIN DI * PIS; DI *• DI 
Di; DS <• LIT 
LOC 
LOC 
LOC 
P14CDS * 
P10CDI * 
DS «- LIT 

P11CDI «■ 
SI * LOC 

pi ♦ di; 

P13CDI ♦ 



P2 
SI 
SI 
SI 



P5; 
P7; 
P9j 
LIT ' 
DI - 

; 

DI - 

pis; 



DS * 

DS «■ 
DS * 

"); 

i; ds 



♦ D1#P5 «• 
*■ DH3,P10 
ABS(EXP)#Pl3 * 
+ P2; P3CDS 

dec; 
dec; 
dec; 

♦LIT "E"J 
LIT "D")J 



DH1, 

* (DLN)# 

shft#p14 * zer0s*p15 
«■ lit »-♦•); 



*BUFF); 



pfl 

P6 

P8 

DS 

* 



M H 



i; ds 

DS * 



lit "-«); 

dec; 



• 



end; 
buff «■ p; 

F J 



ds ♦ 



P2; 

P13 



SI * 

chr; 



p?J 
ds 



si - 

LIT 



SI + 



i; 

JUMP 



out to x); x* 



go to comm; 
comment f conversion; 

IF DTOG THEN 

IF PS>0 
THEN QOUBLE(WHl/wH2#.TENtPS3»TEN[69 + PS3#x,*,WHi»WHa) 
ELSE D0UBLE(WHl#MH2»TENt-PS3#TENt69-PS]#/#*#Wm#WH2) 

ELSE WHl * IF PS > THEN WHlxTENfPS] ELSE WH1/TENC-PS3 ; 



02953^00 

02953500 

02953600 
02953700 

02953800 
02953900 
02954000 
02954100 
02954200 
02954300 
02954400 
02954500 
02954600 
02954700 
02954800 
02954900 
02955000 
02955100 
02955200 
02955300 
02955400 
02955500 
02955600 
02955700 
02955800 
02955900 
02956000 
02956100 
02956200 
02956300 
02956400 
02956500 
02956600 
02956700 
02956800 
02956900 
02957000 
02957100 
02957200 
02957300 
02957400 
02957500 
02957600 
02957700 
02957800 
02957900 
02958000 
02958100 
02958200 
02958300 
02958400 
02958500 
02958600 
02958700 
02958800 
02958900 
02959000 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



052l»2 
052211 

0522«2 
0522*3 
0523*1 
0523*3 
0523*3 
0523*3 
0524*2 
0526*0 
0527*3 
0528*1 
0530*2 
0532*2 
0532*2 
0533*0 
0534*0 
0534*3 
0535*1 
0540*0 
0543*0 
0545*0 
0545*0 
0545*2 
0546*6 
0550*0 
0553*1 
0554*2 
0554*2 
0557*0 
0558*0 
0559*1 
0559*1 
056i?0 
0563*1 
0565*1 
0567*2 
0568*1 
0569*0 

0569*3 
0570*2 
0572*1 
0573*3 
0574* 1 
0575*3 
0576*1 
0576*2 
0577*3 
0579*2 
0579*3 
0580*1 
0580*3 
0580*3 
0581*0 
0581*3 
0586*0 
0590*1 



€ 

m 

m 



FAJ 



BEGIN 



IF WHl^o AND WH2=»0 THEN ExP*0 ELSE 



ti «■ -cdt+d; rndqff; 

finde; 

if exp<0 then exp<-0; 

if ct1*-dt + exp + 1)> 12 

Tl <- dt; SCALED 

IF ABS(WHl) > MAX THEN 



THEN DT*DT-(ZER0S«"T1M2); 



BEGIN 



• 



end; 



DT * 

Tl ♦ 

end; 



DT 

-1; 



' 1; zeros 
scale; 



* zeros + i; 



DT*-DT + EXP +1J SETD; 
IF W<CTl<-D + 2+ SGN + EXP) 

skp«-w-ti; 
numconvert; 
streamcp1 *• 0jp2 «- skp,p3 «■ sgn*p4 «• dl#p5 «• 
p6 «• d2»p7 «• dh2»p8 * d3*p9 * dh3*p10 

Pll «• EXP*P12 «• BUFF); 
BEGIN 01 * PIZ; DI * DI 
DIJ DS <- LIT 
LOC P5; DS * 
P7; 



DI 
P2 
SI 
SI 
SI 



LOC 
LOC 



PlOtDS * 

PI «• DU 

PI 1 CO I * 

DS «• 



P9; 

LIT 

P2; 
LIT 



DS 
OS 
"0"); 

Si «■ 



+ 

P4 
P6 
P8 



P2; 
"; 

dec; 
dec; 
dec; 



THEN GO TO AST; 



DH1, 

* ZEROS* 



P3CDS «• LIT "-"); 



end; 
buff «• p; 



P2; si * si + i; 

JUMP OUT to x>; 



ds * pii chr; 



x* 



IF gtog then go to ga; 
go to comm; 
gj comment g conversion; 
gtog «■ true; 

IF WH1*0 AND WH2*0 then ExP*0 
(GT0GA*-W-D-SGN>4) THEN 
EXP< C-l) THEN GO TO E; 
(T1*D-EXPM)<0 AND GTOGA THEN GO TO E; 

* d; w «• w«4; 
DT *■ Ti; 



else finde; 



buff); 

DI «• 



IF 
IF 
IF 

WT 

D > 

go to fa; 
ga: 

STREAMCP1 *• 05P2 *• 
BEGIN DI *• P2; 
BUFF ♦• p; 
w ♦• w + 4; D 
GO to comm; 
AST: 

stream(pi <• etp2 «• 

BEGIN 01 «■ P2; 
BUFF *• Pi 

IF GTOG THEN GO TO 
COMM: 

END convert; 

comment ********** 

IF EDITCODE=0 OR EDITC0DE=2 



di +4; PI * di; 



end; 



wt; 



BUFF#P3 * 
P3(DS 

ga; 



w); 

*• LIT 



♦»*" ); 



pi ♦ di; 



end; 



END OF DECLARATIONS 
OR EDITC0DE=4 THEN 



* * ; 



02959100 


T 


0595*2 


02959200 


T 


059812 


02959300 


T 


0599*0 


02959400 


T 


0602*0 


02959500 


T 


0603*0 


02959600 


T 


O6O5SO 


02959700 


T 


061050 


02959800 


T 


0612*0 


02959900 


T 


0613*0 


02960000 


T 


061312 


02960100 


T 


0616?0 


02960200 


T 


0618*0 


02960300 


T 


0618*0 


02960400 


T 


0618*0 


02960500 


T 


0621*0 


02960600 


T 


0624*1 


02960700 


T 


0625*2 


02960800 


T 


0627*0 


02960900 


T 


0628*3 


02961000 


T 


0630*0 


02961100 


T 


0630*3 


02961200 


T 


0632*3 


02961300 


T 


0633*2 


02961400 


T 


0634*1 


02961500 


T 


0635*0 


02961600 


T 


0635*3 


02961700 


T 


0637*0 


02961800 


T 


0637*1 


02961900 


T 


0639*0 


02962000 


T 


0640*1 


02962100 


T 


0640*2 


02962200 


T 


0641*0 


02962300 


T 


0642*0 


02962400 


T 


0644*0 


02962500 


T 


0644*0 


02962600 


T 


0644*3 


02962610 


T 


0649*0 


02962700 


T 


065111 


02962800 


T 


0653*1 


02962900 


T 


0656*3 


02963000 


T 


0658*3 


02963100 


T 


0660*0 


02963200 


T 


0660*2 


02963300 


T 


0660*2 


02963400 


T 


066H3 


02963500 


T 


0662*3 


02963600 


T 


0663*1 


02963700 


T 


0665*1 


02963800 


T 


0665*3 


02963900 


T 


0665*3 


02964000 


T 


0667*1 


02964100 


T 


0669*1 


02964150 


T 


0669*3 


02964200 


T 


0670*3 


02964300 


T 


0670*3 


02964400 


T 


067l»0 


02964405 


T 


067j 10 



i 

« 

• 
• 






• 



c 



• 



BEGIN 

pcmks*filx*qkadR) ; 

IF E0ITC0DE=4 THEN PCFI *FMTA* INTC ALLC *PC ,LI SX > **H55 ) ) 

ELSE PC(-1>J.FMTA,*P(,LISX),EDITC0DE,0,INTCALL(0#?16Q)> ; 
P(XiT) ; 

end ; 

if editc0de=6 then go zap; 

FIB «• FILXCNOT 23; * OPEN FILE IF NOT OPEN 
IF DKAOR < THEN BEGIN FLG <• I; DKADR *0 END; 
IF FTBC53.U3I1] THEN P ( MKS. 0, 0* F ILX* 1 * SELECT ) ; 
PRNTR«-2x(FIBC53.C41«2]^0} ; %%% IFF FILE IS CLOSED* SETS PRNTR , [ 46 * 1 3*1 , 

ckpb; arraystuff * o; 

IF FIBCO] = THEN 

FIBCC] * i + (EDITCODE sO OR EDITCODE «2) 
ELSE 
IF FIB CO] /I + (EDITCODE *0 OR EDITCODE = 2) 
THEN P(MKS*FIBt63*FILX.C33*l5]*4* FORT ERR); 
PRNTR THEN STREAMC TPAR ) ; DS*8LIT" « ; 
TO P(EDITC0DE*0UP*ADD)J 



IF 
GO 
GO 
GO 
GO 
GO 



TO 
TO 
TO 
TO 
NOFL* 

P(XIT) ; 

FNOL* 



nofl; 
fnol; 
binary; 
fmtlst; 



x no format* no list 

% format* no list 

% no format* list 

% format* list 



LSTRN«--i; 

GO TO frmtcd; 



nmlst* 

P(xIT); 
binary: 
P(xit) ; 
fmtlstj 

lstrn ♦ i; 
ctQg *• 



DQNETOG 
6ETLIST; 



<■ false; 



FRMTCD? 






first format character 
then go to fmerr ; 



STATEMENT 



prnt; 



ps ♦• o; 

NFCI ♦ CFIxS) +2; % 
IF NOT(NFCs"(" OR CHR*"X") 
NFCI ♦ CFI*8) + 2; 
NFPHJ FORMATCONTROL* % ANAYLSIS OF FORMAT 
IF FMERRTOG THEN GO TO FM^RR; 
FMCYCJ IFCDONITOG <• ENDLI5T) THEN 

IF EDITC0DE=6 THEN GO ZIPIT ELSE 
IF W + NCR > LCR THEN GO TO FMERR; 
NCR'-* W + ncr; 

convert; 

GETLIST; 

IF CRPT*RPT-1) > THEN Go TO FMCYC; 

IF EDITC0DE=6 THEN GO ZIPIT ELSE 

go to nfph; 
zapsrpt«-27;c0de*atype;in*wt*-6;d«-0;buff«-tpar.c33:i53;getllst; 

lcr*168; go fmcyc; 
zipit5 stream(p1*buff); begin dl*pl> ds<- 5 lit «;end, w ; end* 

p( , tpar, l0d*4*c0m, del); 

BUFF * TPAR, [331153* 



02964410 
02964415 
02964420 

02964425 
02964430 
02964435 
02964450 
02964500 
02964510 
02964600 
02964610 
02964700 
02964710 
02964720 
02964730 
02964740 
02964750 
02964765 
02964800 
02964900 
02965000 
02965100 
02965200 
02965400 
02965500 

02965700 
02965800 
02965900 
02966000 
02966100 
02971000 
02971100 
02973100 
02973200 
02973300 
02973400 
02973500 
02973600 
02973700 
02973800 
02973900 
02974000 
02974100 
02974200 
02974250 
02974300 
02974500 
02974600 
02974700 
02974800 
02974850 
02974900 
02974950 
02974953 
02974954 

02974956 
02974958 



T 

T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 



068610 
0686*2 
068711 

069l«l 
069512 

0695*3 

069513 

0697«0 

0698*3 

0701 *2 

0704*2 

0707*0 

0708*3 

0709*3 

0712*1 

0713*2 

0716*0 

0719*2 

0722»3 

0723*3 

0724*1 

0724*3 

0725*1 

0725*3 

0725*3 

0726*0 

0726*0 

0727*0 

0727*2 

0727*2 

0727*3 

0727*3 

0728*0 

0728*0 

0728*3 

0730*0 

0731*0 

0731*0 

0731*3 

0733*2 

0737*0 

0738*3 

0740*0 

0741*0 

0742*2 

0745*0 

0746*3 

0748*0 

0749*0 

0750*0 

0752*1 

0753*0 

0754*0 

0760*0 
0761*1 

0763*2 
0764*3 







STREAM(Pt<-BuFF);BEGlN DI*pU 17CDS «• 8 LIT " "HEND* 

pcxid; 

FMERRJ 

PCMKS*FIB[6 3*FILX.C33J153*0*FOrTERR)>' 
TYPERRJ 

P(MKS,FIB(:6 3,FILX,C33J15]*2*F0RTERR)*' 
END FTOUTj 



02974960 
02974962 
02975000 
02975J00 
02975200 
02975210 
02975300 



0766*1 
0769'1 
076952 
0769*2 
0772 »0 
0772*0 
077410 






SIZE* 0775 WORDS 



*w 



• 



PROCEDURE FORTRANFREEWRITE(FlLX*DKADOR*R*W*LISX*NI*NAMS*SuBS) ;*INT #153 

START OF REL 
VALUE DKADDR#R#LISX#W#Ni; INTEGER R*WJ REAL DKADOR* LI SX* NI ; 
ARRAY Su8S[*l» NAMSC*3J! NAME FILX '> 
BEGIN 

INTEGER LSTRN»19* E* CHR* MAXCHR* PRNTR* TYPE* INDX* SIZE* 
WDTH* MAXWOTH, SGN* CC J 

REAL LISTYPE = 20, ARRAYSTUFF* 18* ALGDLWRITE-12* SELECT"i4* Tl* NID* 

T2* F0RTERR=24* BUFF* BSIZE* FLG* WH1»R* D* WH2* ARY* T3* WH1S* 
RNDUPc9* MNTSSAM7* FNR> FNL> ENR* MS3* DECPT* LSSl* SVMAXWDTH* 
GTRMI, WH3* HALF* TRZ* NN1* TWQT* VH="i* VL=-2* TlPE*-4 ; 

NAME LISTADQR i 

ARRAY TEN=22E*3* AR1 *L I STADOR C * 3 * TpAR*23[*3* FPB*3C*3* FI8E*3 * 

LABEL BACK* START* ITYPE* ALlST* TRU> FALS* TWQPT5» MAXI* SETUP* 
LOGS* FTYPE* ETYPE* FUNNYE* CHOOSER OVRFLW* FlVEPT* GET3* 
HUNT* ZERO* HLF* NOFIT* GOTQQ* ZEROES* FITYPE* ETYPE2* Q* 
ETYPEl* DFTYPE* DTYPE* BUMPWH3* THREL* THREH* MAXWDTHQF1* Ql* 
MAXI1 i 

DEFINE DONE * (LSTRN=(-1)) #* 
REEL = 3 #* 
LOGICAL ■ 4 #* 
INTEGR * 1 «> 
DBLPREC a 5 #> 
COMPLEXR - 6 #* 
COMPLEXl s 7 ** 

MAYBE(MAY8E1*MAY8E2*MAYBE3) * CI*C I + MAYBE1 ; GO TO MAYBE2 i 

OS«-LIT MAYBE3; MAYBE2! #* 

TWOD = LISTYPE,C38»13 #* 
INDXF = C18U53 #* 
TYPEP = C44J43 #* 
SIZEF ■ C33U5] # ; 

SUBROUTINE GETWDTH } 

WOTH*((FNR*E+RNDUP)<FNL*0) + l+GTRMI«-i*{ABS(FNF)>9) * 

REAL SUBROUTINE FTEST ; 

FTEST<.P(XCH) + (FNR«.T2-FNL*FNL-LSS1)<(-E) OR FNR<0 ; 

REAL SUBROUTINE NXTELM J 



02976020 
segment; DISK 
02976035 
02976050 
02976065 
02976080 
02976095 
02976U0 
02976125 
02976140 
02976155 
02976170 
02976185 
02976200 
02976215 
02976230 
02976245 

02976260 
02976275 
02976290 
02976305 
02976320 
02976321 
02976335 
02976350 
02976365 
02976380 
02976395 
02976410 
02976425 
02976440 
02976455 
02976470 
02976485 
02976500 
02976515 
02976530 
02976545 

02976560 
02976575 

02976590 
02976605 
02976620 
02976635 
02976650 



T 0000 
ADDRESS 



T 
T 
T 
T 

t 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000 
0000 
0000 

0000 

0000 

0000 
0000 
0000 

0000 

0000 
0000 
0000 

0000 

0000 

0000 
0000 
0000 
0000 
0000 
0000 
0000 
0000 
0000 

0000 

0000 
0000 

0000 

0000 

0000 

0000 
0000 

0000 
0000 

0000 

0000 

0000 
0000 
0001 

0006 
0006 
0007 
0012 
0012 



10 

s 

so 

10 
JO 

to 

JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
50 

JO 
JO 
JO 
JO 
JO 
JO 
50 

50 
JO 
50 
JO 
JO 
JO 
JO 
JO 
JO 

50 
50 
50 
50 
50 
JO 
JO 

53 
53 

50 
JO 
JO 



Q0403 



• 



€ 



• 



[40t83#CQC) 



• 



BEGIN 

P(IF TWDT THEN P C * C AR 1 £ INDX , C 33 * 73 3 3 > INDX , 

ELSE AR1C1NDX3) J 
INDX*INDX+1> NXTELM«-P • 
END OP NXTELM } 

SUBROUTINE COUNTZ 5 
BEGIN 
T3«-Q 5 
HUNT? IF LISTYPE MOD TEN[T3*T3+33»0 THEN GO HUNT * 
IE LISTYPE MQO TENCT1<-T3-»13X0 
THEN T1«-T1-1-(IISTYP£ MOD TEIMCTl-1 3^0) I 
END OE COUNTZ ; 

REAL SUBROUTINE USEXPNOTAT ION } 
BEGIN 

FNL«-IE LSSI THEN PCC-EW) ELSE P(0,E+1) i 
IF CFNR«-P + ENR-FNL-T1)<0 THEN FnR*1 * 

USEXPNOTAT I ON* (FNR + FNt>l + (ENR*ENR-Tl ) + ((DECPT>l ) + T3«-( w\ >£ ) * 
(ABS(E+1)>9))+(TRZ OR LSS1) AND CA8SCE)>4 OR 
FNL+FNR>MS3+2)) OR CENR+T3<MS3 AND A6S(E)>5) i 
END OF USEXPNOTATION i 

SUBROUTINE ROUNDANOSPL I T J 
BEGIN 

T1*T2*.LISTYPe*0; T3<-RNDUP + 7 ; 
IF (MNTSSA*GTRMI-7-RNDUP) USS THEN 

BEGIN 

PCWH3/TENC-MNTSSA]-l#,WH3,ISD); T3+GTRMI ; 
BUMPWH3: IF (WH3^WH3 + l)sTENCT33 THfN E* ( L I STYPE* 1 ) + E I 

END 
ELSE IF MNTSSA LSS 8 THEN 

BEGIN 

IF PCWH2/TEN[8-T2<-MNTSSA3,.WH2>ISN)*TENCMNTSSA3 

THEN GO BUMPWH3 I 

END 

ELSE IF PCWH1/TENC16-MNTSSA3».WH1#ISN)*TEN[T1*MNTSSA»T2*B3 

THEN IF <WH2«-WH2 + 1)-TENC83 THEN GO BUMPWH3 * 
END OF ROUNOANDSPLIT ; 

SUBROUTINE OUTPUT ; 
BEGIN 

IF PRNTR THEN 
BEGIN 
FIB[173*-FIBC173 + 8SIZE * 

PCMKS,2,0#CC»BSIZE#FILX#ALG0LWRITE) * 

IF NOT(*FILX), C1U9] 
$ SET OMIT = TIMESHARING 
$ SET OMIT ■ NOTCTIMESHARING 3 

THEN IF FIBC43 • C8l 43X10 

THEN PCFlLX*e20000OO000»36#C0M#DEL*DEU) i 
$ POP QMIT 

'■ END: 
ELSE IF NOT CC THEN P(MKS*FLG* DKADDR#0#BSIZE*FILX# AlGOLHRITE) 
P(MKS,FLG,DKADDR,CHR<-0,C-1),FILX#ALG0LWRITE*DEL) ! 
IF PRNTR THEN FIB C 1 7 3 *FIB C 173'BSIZE / 

STREAM C BS*BSiZE-l » B*P COUP) ,[ 36 |6 J* BUF*BUFF*(*FlLX) i C33 »153) ; 



02976665 


T 


0012*0 


02976680 


T 


0012*0 


02976695 


T 


0015*0 


02976710 


T 


0016*0 


02976725 


T 


0017*2 


02976740 


T 


001713 


02976755 


T 


0017*3 


02976770 


T 


0018*0 


02976785 


T 


0018*0 


02976800 


T 


0018*3 


02976815 


T 


002113 


02976830 


T 


0023*3 


02976845 


T 


0028*1 


02976860 


T 


0028*2 


02976875 


T 


0028*2 


02976890 


T 


0029*0 


02976905 


T 


0029*0 


02976920 


T 


0032*2 


02976935 


T 


0036*1 


02976950 


T 


0040*2 


02976965 


T 


004512 


02976980 


T 


0050*3 


02976995 


T 


005110 


02977010 


T 


0051 JO 


02977025 


T 


0051*0 


02977040 


T 


005i?0 


02977055 


T 


0054*0 


02977070 


T 


0056*1 


02977085 


T 


0056*3 


02977100 


T 


0059*3 


02977U5 


T 


0064*0 


02977130 


T 


0064*0 


02977145 


T 


0065*1 


02977160 


T 


0065*3 


02977175 


T 


0068*2 


02977190 


T 


0069*2 


02977205 


T 


0069*2 


02977220 


T 


0073*3 


02977235 


T 


0077*1 


02977250 


T 


0077*2 


02977265 


T 


0077*2 


02977280 


T 


0078*0 


02977295 


T 


0078*0 


02977310 


T 


0078*1 


02977325 


T 


0078*3 


02977340 


T 


0080*3 


02977355 


T 


0082*2 


02977370 


T 


0083*2 


02977400 


T 


0083;2 


02977415 


T 


0083*2 


02977430 


T 


0085*1 


02977431 


T 


0087*3 


02977445 


T 


0087*3 


02977460 


T 


0087*3 


02977475 


T 


0Q92»3 


02977490 


T 


0095*2 


02977505 


T 


0098*1 



fll 



BEGIN 
DS<-8LIT« 

END ; 

END OF OUTPUT 



* SI«-BUFi OS«-eS WDSJ BCDS«-32WDS; DS02WDS) 



• 



SUBROUTINE CHECKBuMPANDSKlP i 
BEGIN 

IF PCW + MAXWDTH*-WDTH*DUP)<Q THEN P(DEL»0) i 
IF PCPCDUP)+WDTH+2+SVMAXWQTH-MAXWDTH*0UP)+CHR>MAXCHR 
THEN OUTPUT ; 
CHR+-P + CHR i 
STREAM(SKP*LSS1*PIL«-LSS1.C36I6 3*BUFF) ; 

BEGIN Ol*DI + SKP; LCDK-DI + 32; DI*DI+32)i SKP*DI END i 
BUFFER ; 
IF NIDXNI THEN 

BEGIN 

STREAM<n*USS1*NAMS[NI0]).[9»3]ILSS1»T*CNNU0)#BUFF) i 
BEGIN 

SI«-LOC LSS1J 5I*SI+2J DS*N CHRi MAYBEC T> l» " ( M 3 ; N*DIi 
END ; 

BUFF*-P i 

FOR MS3*-0 STEP 1 UNTIL NNl DO 
BEGIN 

STREAMcN*SUBSCM33 3,tl5l33IQ*SU8SCMS3],t33»153*BUFF) ; 
BEGIN SI*LOC Q; DS«-N DEC; DS«-LlT , % f '; N*DI END i 

BUFF*-P } 

end ; 
streamct«-(nn12to)lr*typeacomplexr#i*type«complexi»buff) i 

BEGIN 

CI*CI + T; GO TO Li DUDI-U DS^LIT")"; L* 

CUCI + Ri GO TO Lli DS*2LIT"-R"; Ll* 

cuci + i; go to 12; ns«-2LiT M -i M ; L2* ds*lit m s w ; t*di ; 

END i 
BUFFER i 

end ; 
end of chf.ckbumpandskip i 

SUBROUTINE BASICONVERT i 
BEGIN 
IF TYPE*D8LPREC THEN 

BEGIN T3*0 ; 

IF E>8 THEN BEGIN WH2*-WH1 DIV TENC83i T2*E-T1*8 END 

ELSE BEGIN T2*0; Tl*E END I 

END i 
W0TH*WDTH + TUT2 + T3 + SGN + DFCPT } 
CHECKBUMPANDSKIP i 

STREAM CWH3SWH2*WH1*T3*T2,T1*FNL*DECPT*ENR*SGN*TRZ* BUFF) i 
BEGIN 

maybecsgnj'Li*"-"); sgn«-di ; 

di*-di+decpt; enr(ds<-lit"0"); si*lqc wh3; os*T3 dec ; 

Sl«-LOC WH2i DS«-T2 DEC; SULOC HH1J DS«-Tl DEC i 
TRZfDS«-LlT"0"); WH3*Di; C I«-C I+DECPTi GO TO L i 

si«-sgn; si«-si + i ; di+sgn; ds*fnl chr; ds^lit'N"; l* 

END i 
P ( X C H 3 / 
END OF BASICONVERT } 



02977520 
02977535 
02977550 
02977565 
02977580 
02977595 
02977610 
02977625 
02977640 
02977655 
02977670 
02977685 
02977690 
02977695 

02977700 

02977715 

02977730 

02977745 

02977760 

02977775 

02977790 

02977805 

02977820 

02977835 

02977850 

02977865 

02977880 

02977895 

02977910 

02977925 

02977940 

02977955 

02977970 

02977985 

02978000 

02978030 

02978045 

02978060 

Q2978075 

02978090 

02978105 

02978120 

02978135 

02978150 

02978165 

02978180 

02978195 

02978210 

02978215 

02978225 

02978240 

02978255 

02978270 

02978285 

02978300 

02978315 

02978330 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

■T 

T 

T 

T 

T 

T 

T 

T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 



0101*3 

010113 

0105S0 

0105*1 

0105*2 

0105:2 

O1O6SO 

0106*0 

0109 : 

0112J0 

OIUJO 

011510 

0117*1 

0119*2 

0120:0 

0120:3 

0121*1 

0124:3 

0124:3 

0127*1 

0127:2 

oi2s:o 
0129:0 
0129:0 

0131*3 
0133?3 
0134*1 
0136«2 
0139:3 
0139:3 
0141 s 1 
0142?2 

0144:2 
0144:3 

0145U 
0145:i 
0145:2 
0145*2 
0146*0 
0146:0 
0146*3 
0148*0 
0152*2 
0154*2 
0154*2 
0157*3 
0159*0 

0162*3 
0162*3 
016^*1 
0166:3 
0168U 
0170*2 
0172*1 
0172*2 
0172*3 
0173:0 



• 









SUBROUTINE FINDE J 

E«-C04TU42*3!6]&T1[II2U]+12 + P(HI-F))XP(L068) '* 

SUBROUTINE GETW '> 

IF CT1«-PCX.CH) JiW*MAXCHR/R-PCTW0PT5) THEN W«-U 

ELSE IF CT14-IF NAMS=0 THEN 3C ELSE PCNAMSCN 13 tDUP )x6+CPCXCH)>0} 
♦ 37XW THEN MAXCHR*( C W*T1 )+2 ) xR I 

%************************• : code starts here **************************% 
half«-p(hlf) i 

IF NKO THEN 

BEGIN % SPECIAL SINGLE EDIT, 

buffer; nid*ni; WH1*VH; WH2«-VL * 

IF CTYPE*IF TIPE=2 THEN IF VL = THEN IF ABSC VH )<P ( MAXI 1) THEN 

IF P(VH».TYPE*ISN)=VH THEN 1 ELSE 3 ELSE 3 ELSE 5 ELSE TJPEXO 

OR TYPE>5 TH^N DO UNTIL FALSE ; 

W«-(W«-ABS(W))-SVMAXWDTH«-MAXWDTH«.IF W/O THEN 

MAXCHR«-64; GO Ql } 

END i 
FIB4-FILXCNOT 23i IF DKADOR<0 THEN BEGIN FLG*i; 
D*IF R.CUl] THEN "," ELSE " "} R*ABS(R) ; 
IF FIBC51 • C43J 13 THEN P( MKS> 0, 0> FILX* 1 * SELECT ) j 
CC*(FIBC53 AND 96)*0 ; 

PCHKS»FLG»DKADDH#0*C-1)»FILX' ALGOL WRITE) i 
IF PC*[FIBC14J3>T0P) THEN PCDEL) 

ELSE P((TU(*(4 INX P(XCH ) ) ) , [ 36 5 63 )/0 AND Tl/8 
MAXCHR«-P(BSIZE«-P)x8 ; 

IF PRNTR<-Cm«-FIB[43,[8843)B1 QR Ti=7 OR Tl=12> 
,U.3Jll3 + 33,[43*53<20 THEN 

BEGIN IF BSIZE>16 THEN BEGIN M A XCHR*132; 8SIZE*17 
ELSE CO! * 
OUTPUT J 

IF CCC«-0)»FIBCO] THEN F I B C 3 «• 1 ; 
IF (LSTRN*1)XFIBC03 A N0 Tl«2 

THEN P(MKS,FIB[73,FILX,C33U53M/FOrTERR) i 
MAXwDTH«-MAXCHR-2 



02978345 T 0173*0 



W ELSE 62 ; 



DKADDR*0 END 



AND 
AND 



Tl/9,SUB) i 
FPBCFI8C4] 
END) END 



IF (W«-ABSCW))XO THEN 

BEGIN 

IF W>MAXWDTH THEN 

IF R*0 THEN BEGIN 

END 
ELSE IF R*0 THEN BEGIN 
I"UW*SVMAXW0TH*MAXWDTH j 



W*MAXWDTH 



P(MAXWOTH); 

pen; getw; 



ELSE MAXWDTH«-W 
GETW END * 



MAXWDTH<-W END 



GO 
HLF5 * * 
LOGS 



; 






START 
0,5 J 

0.90308998709 ; 
TWOPT55 * *2, 4999999999 ; 
MAXI1MS $0007777777777777 } 
BACK* » 

BUFF*PJ IF NKO THEN P(8UFF»RTN) 
STREAMCDSBUFF); BEGIN SI*LOC DJ SI*Sl + 7; DS«-CHr; DUOI + U D*0I END 
BUFF*P J 
START: 

IF ARY THEN 
BEGIN 
AUISTI WH1*NXTELM / 



TYPE*ABS(TYPE) ,* 



02978360 


T 


0173*0 


02978375 


T 


0177*2 


02978390 


T 


0177*2 


02978405 


T 


0178*0 


02978420 


T 


0l8i!l 


02978435 


T 


0186*2 


02^78450 


T 


0l9i<2 


02978465 


T 


0191*2 


02978480 


T 


0191*2 


02978485 


T 


0191*2 


02978487 


T 


0202*0 


02978489 


T 


0202*3 


02178491 


T 


0203*1 


02978493 


T 


0206*1 


02978495 


T 


0209*3 


02978497 


T 


0215*3 


02978499 


T 


0218*2 


02978501 


T 


0223*2 


02978503 


T 


0224*3 


02978510 


T 


0224*3 


02978525 


T 


0229*1 


02978540 


T 


0233*0 


02978555 


T 


0236*0 


02978560 


T 


0238*0 


02978565 


T 


0240*0 


02978570 


T 


0241*3 


02978575 


T 


0247*0 


02978585 


T 


0248*2 


02978590 


T 


0252*3 


02978600 


T 


0256*0 


02978615 


T 


0259*1 


02978630 


T 


0260*2 


02978645 


T 


0262*0 


02978660 


T 


0265M 


02978661 


T 


0267*0 


02978675 


T 


0270*1 


02978690 


T 


0271*2 


02978705 


T 


0273*0 


02978720 


T 


0273*2 


02978735 


T 


0276*3 


02978750 


T 


0279*0 


02978765 


T 


0279*0 


02978780 


T 


0282*3 


02978795 


T 


0284*2 


02978810 


T 


0285*0 


02978825 


T 


0286*0 


02978840 


T 


0287*0 


02978842 


T 


0288*0 


02978855 


T 


0289*0 


02978870 


T 


0289*0 


02978885 


T 


0292*1 


02978900 


T 


0294*3 


02978915 


T 


0295*2 


02978930 


T 


0295*2 


02978945 


T 


0295*3 



02978960 T 0296*1 



e 



• 
• 



THEN WH2«-NXTELM* ARY*INDX<SIZE ; 
THEN BEGIN WH1*LISTADDRC 1 ]i TYPE«"COMPLEX I END 

TYPE*LISTYPE f TYPEF ; 



IF NIDXNI THEN 
BEGIN 

PClNDX^ARRAYSTUFF.lNDXF) j 

IF TYPE>DBtPREC THEN PCCP + 1) OIV 2); T2*P J 

IF TYPE>COMPLEXR THEN TYPE*CQMPLEXR+C TYPE*CQMPLEXR } i 

FOR T1*NN1 STEP "1 UNTIL 00 

BEGIN 

SUBStTl].G33«15]*l + CT2-l) OIV C MS3*SUBS CT1 3 , C 18 * 153 5 J 

IF <T2*T2 MOD MS3)=0 THEN T2*MS3 ! 

END i 
END ; 
IF TYPEsDBLPREC 

END 
ELSE IF TYPE=COHPuEXR 
ELSE BEGIN 

P(ARRAYSTUFF«-0); L ISTADDR* CL ISX 3 ; 
IF (NID«-ARRAYSTUFF.C3S15] + NI)/NI 
THEN NN1*-NAMSCNI03 .CI 583-1 / 
IF ARY«-ARRAYSTUFF.CJ.8J303^0 THEN 
BEGIN 

IF NIDXNI THEN 
BEGIN 

su8sco3.cie»i5]*Ti*i ; 

FOR T2*l STEP 1 UNTIL NN1 00 SUBStTg] , [ 181 153*Tl 

<-TlxSUBSCT2-U i E33»153; 

end ; 

if type-complexr then type*c0mplex i } 

SlZE«-ClNDX«.ARRAYSTUFFtlNDXF) + ARRAYSTUFF«SIZEF ) 
PCLISTADDR*MEMaiSTADDR,E18*153 3) i 
TWDT^NOT P(LOD,TOP)i P(DEL) * 
GO ALIST ; 
END i 
WH1«-LISTADDR[03J P(DEL) i 
IF TYPE=OBLPREC THEN WH2*L 1ST ADDR [ 1 3 i 
END i 
IF DONE THEN 
BEGIN 

STREAMCTPAR); 18 CDS*8L IT" '♦) } 

IF NOT PRNTR THEN PC MKS> FLG> DKaDOR* 0* BSIZE* FILX* ALGOLWRITE ) ; 
P(XIT) ; 

END ; 
MAXWDTH«-SVMAXWOTH ; 

IF NID^NI THEN 
BEGIN 

T3*CNNl>0)+(NAMS[NID3.[9:33)+2+NNl+PCABSCTYPE)£C0MPLEXR#DUP>+>; 
FOR TUNN1 STEP -1 UNTIL DO 

BEGIN T2«-0j MS3*SUBSCTl].C33»153 ; 

while tenct23<ms3 do t2«-t2+l ; 

t3<-t3 + t2j subsct13 ,c15}3]«-t2 ; 

end ; 
if cmaxwdth*maxwdth«t3)s0 then go ovrflw i 
end ; 
h* if type=logical then 

BEGIN 

IF CWDTH*7-WH1*WH1 AND 1)>MAXWdTH 

CHECKBUMPANOSKIP J 

STREAM<S*IF WH1 THEN PCTRU) ELSE 



THEN WDTH«-MAXWQTH } 



PCFAUS)I2*T1*MDTH>1# 



02978990 


T 


02979005 


T 


02979020 


T 


02979035 


T 


02979050 


T 


02979065 


T 


02979080 


T 


02979095 


T 


02979110 


T 


02979125 


T 


02979140 


T 


02979155 


T 


02979170 


T 


02979185 


T 


02979200 


T 


02979215 


T 


02979230 


T 


02979245 


T 


02979260 


T 


02979275 


T 


02979290 


T 


02979305 


T 


02979320 


T 


02979335 


T 


02979350 


T 


02979365 


T 


02979380 


T 


02979395 


T 


02979410 


T 


02979425 


T 


02979440 


T 


02979455 


T 


02979470 


T 


02979485 


T 


02979500 


T 


02979515 


T 


02979530 


T 


02979545 


T 


02979560 


T 


02979575 


T 


02979590 


T 


02979605 


T 


02979620 


T 


02979635 


T 


02979650 


T 


02979665 


T 


02979680 


T 


02979695 


T 


02979710 


T 


02979725 


T 


02979740 


T 


02979755 


T 


02979770 


T 


02979785 


T 


02979800 


T 


02979815 


T 



Q297»2 
0298*1 

0298*3 
0300*0 
0302*3 
0305*3 
0307*0 
0307*0 
0310*3 
0315*0 
0317*1 
0317*1 
032i*3 
032l*3 
0325*3 
0326*1 
0329*0 
330*3 
0333*3 
0335*2 
0336*0 

0336*3 
0337*1 
0339*3 
0342*0 
0343*0 
0347*2 
0349*2 
0352*1 
0354*1 
0355*3 
0356*1 
0356*1 
0357*1 
0360*0 
0360*0 
0361*0 
036j»2 
036452 
0367*1 

0367*2 
0367*2 
0368*1 
0369*0 
0369*2 
0374*0 
0376*0 

378*1 
038JJ2 

0385*1 
0387*2 

0389*3 
0389*3 
0390*2 
0391*0 
0395*0 
0396*0 



• 



if 



€ 



• 



• 



• 
# 



DTYPE* 



GOTOQ? 



MAVI : * 
THREH 
THREL 
TR(j : s 
FALS* 



} 



Q«-T2«"WDTH>2,WDTH*WDTH-T1*T2>F*3 + WH1>BUFF) ; 
BEGIN 

si*loc s; SI«.SI+FJ MAYBECZ^Ll*",") } 
D5«-WDTH CHR; MAYBECQ#L2»«,")J S*DI ; 

ENB ; 
GO BACK J 
END OF LOGICAL i 
SGN*HH1 , t li 13 I 

Ql IF T3*N0T CGTRMI*-A8S(WHt)>P(MAXn) AND TYPE*INTEGR 
THEN P(WH1» ,WH1#ISD) i 

T2«-cMS3*MAXWDTH-3-SGN) + 2; whi*abscwhi.) ; 
IF TYPErRBLPREC THEN 

BEGIN 

WH1«-T1«-PCWH2,WH1,0#TEN[0],DLM); WH2«-P ; 

IF WH1 = THEN BEGIN TYPE«--DBLPREC ', GO ZERO END; FJNOE 

IF MAXWDTH<7 

THEN PCWH2#WH1»HALF#(N0T PCMAXD3 AND n\\\, DL A# , WH1S, *■> DEL ) 

IF LSS1*E LSS THEN P.CQ* TENCO] #TENt 69-E3 * TENE -E 3 > OLD 5 

ELSE PCTEN£69+E3,TENCE3) ; 

ti*p; T3«-p ; 

IF Tl GEO WHl THEN IF Tl>WHl OR T3>WH2 THEN E*E-l > 

ENR«-24 i 

P(WH2,WH1#TENC69 + ABS(E)3»TENI:abS(E)3*IF LSS1«-E LSS THEN 

P(DLM) ELSE PCDLD)) '> 
Ti«-P; T3*P } 

if trpcthreh) then if tl>p(threh) or t3>p(threl) then enr*23 /' 
p(wh2,wh1^ten!:(t1<.abscenr-e-1)3 + 693#tenct13*if enrse then 
pcdld) else pcdlm>) ** 

WH1*PJ RNQUp*ENRs24 I 

PtT3«-P,WHl*TEN[85 3»TENtl6 3#DLD»HALF*'"#.HH3»ISO*DEl.#T3f WH1*0*HH3 

*TENC853*TEN[16]#DLM#DLS) ; 
HHi*P 1 
P(T3<-P,WH1*Q,TEN[8 3>DLD>HALF*-,,*WH2#ISd>OEL*T3,WH1>0,WH2*Q*TENC 

83*0LM^DLS,,WHJ,ISD»DEL) '* 



; 



IF 



THEN 



P(0»0) = LISTYPE<-WH1 
BEGIN P(DEL,8) ; 

IF CLISTYPE*-WH2)«0 THEN BEGIN PCDEL#16)J LISTYPE*WH3 END ; 
END i 
countz; T1*P+T1 ; 
IF USrXPNOTATlON THEN 
BEGIN 
IF ENR+T3>MS3 THEN 

IF E*T2 THEN BEGIN 



decpt*fnr*0! qo dftype 
else if cenr*ms3-t3)<0 then 

begin whuwhis; type«--d8lprec; 
gtrmi«-enr> roundandsplit ; 
if not (9xe or t3*l) then go gotoq ; 
if listype then p (ten [ (t3*t 3+c if lssl then -10«e 

E))) - 13».WH3*IS0) i 

ETYPEl ; 



END 
GO Q END ; 

ELSE »(9* 



RNDUP*lj GO 
90007777777777777 
P1143013331500045 
P0003112121167260 
"TRUE" > 
"FALSE" ; 

end ; 
if fnl + fnrst'2 then 



02979830 


T 


0399? 2 


02979845 


T 


0403*1 


02979860 


T 


0403*1 


02979875 


T 


0405*1 


02979890 


T 


040/*! 


02979905 


T 


0407*2 


02979920 


T 


0408*0 


02979935 


T 


0408*0 


02979950 


T 


0409*1 


02979965 


T 


0411*2 


02979980 


T 


0413*3 


02979995 


T 


0417*2 


02980010 


T 


0418*1 


02980025 


T 


0418*3 


02980040 


T 


0421*3 


02980055 


T 


0426*0 


02980070 


T 


0426* 1 


02980085 


T 


0430*0 


02980100 


T 


0434*2 


02980115 


T 


0436*2 


02980130 


T 


0437*2 


02980145 


T 


0442*1 


02980160 


T 


0443*0 


02980175 


T 


0446*3 


02980190 


T 


0448*1 


02980205 


T 


0449*1 


02980220 


T 


0453*0 


02980235 


T 


0458*0 


02980250 


T 


0459*2 


02980265 


T 


0461*1 


02980280 


T 


0465*1 


02980295 


T 


0467*0 


02980310 


T 


0467*2 


02980325 


T 


047j *3 


0298034Q 


T 


0473*2 


02980355 


T 


0475*0 


02980370 


T 


0476*0 


02980385 


T 


0479*0 


02980400 


T 


0479*0 


02980415 


T 


0481*0 


02980430 


T 


0482*0 


02980445 


T 


0482*2 


02980460 


T 


0483*3 


02980475 


T 


0487*1 


02980490 


T 


0489*2 


02980505 


T 


0492*1 


02980520 


T 


0494*0 


02980535 


T 


0496*1 


02980550 


T 


0499*3 


02980565 


T 


0502*2 


02980580 


T 


0503*3 


02980595 


T 


0505*0 


02980610 


T 


0506*0 


02980625 


T 


0507*0 


02980640 


T 


0508*0 


02980655 


T 


0509*0 


02980670 


T 


0509*0 



• 

• 



c 



• 



GETWDTH ; 
GO GQTQQ • 



THEN ENR«-0 



BACK I 

THEN GO DFTYPE ; 



• 



BEGIN 

oftype: enr«-trz«.o; ti«-fnl * 

if lssl then enr<-fnl-e"1 
else if 23+rndup<fnl then 

begin trz«-fnl*fnr-tu23+rndupi fnr«-0 eno 
gtrmi«-tl+fnr^enrj roundandspli t ; 
if listype then 

BEGIN 

IF OECPT THEN DECPT*FNR*TRZSl 

ELSE BEGIN 

Tl«-T2*0J DECPT*WH3*T3*RNDUP<-11 

IF CTRZ*--WDTH + WdTH*MS3+1)<0 THEN 

GO ETYPE2 } 

END ; 
FNL*FNL+(E>0) * 
IF LSSl THEN IF NOT ( TRZ* C ENR«-ENR"< 1 ) >0 J 

IF T.KDECPT THEN GO GOTQQ i 
P(TFNCCT3*T3+1-0ECPT)-13#,WH3»IS0) * 

ENO i 

FITYPE* WOTH«-ENR + TRZ; BASlCONVERT/ GO 
END i 
P(WH3/TEN[RNDUP+6]>5); if not ftest 
GO DTYPE /* 

end of dblprec ; 

IF -MAXWDTHal THEN GO TO MAXK'DTHQFl ; 
Ti«-TEN[0]XWH1 i 
IF E*WH1X0 THEN 

BEGIN FINDER E*E-UIF E>0 THEN TENEE3 ELSE 1/TENC-E] »Tl > END * 
IF T3 AND EST2 THEN 

BEGIN E«-E + l } 

itype: decpt*o; go setup ; 

END '> 

IF WHlsO THFN 
ZERO* BEGIN FNR^O; FNL*i; GO FTYPE END ; 

RNDUP*(MNTSSA*P(MH1*T1»TENCABSCE)]»IF LSS1<-0>E THEN 

P(x) ELSE PC/))) GEQ 5 J 
LISTYPE*P(WH1»TENCABS((ENR*12-{MNTSSA>P(FIVEPT)))-E-1>3* 

IF GTRMI THEN PC/) ELSE PC*)) ) 
COUNTZ J 

IF GTRMI OR USEXPNOTATION THEN 
BEGIN 

IF ENR+T3 LEO MS3 THEN 
ETYPE* BEGIN 

PCWH1) i 

IF NOT RNDUP*TYPE*lNTEGR OR DECPT=0 THEN 
R E f 1 T N 

ENR*P(E>10 AND CE«-E«ENR)S10,DUP) + 1 + ENR t 
DECPT<-OJ PCTENCE«-«P + E3*/) * 
END 
ELSE PCTENUBSCE+l-ENR)3*lF E<ENR THEN PC*) ELSE PC/)) ; 
PC.WH1MSD) ; 
IF WH1=TENCENR3 THEN 
BEGIN 

IF CENR*ENR+PCE+RNDUPMF LSSl THEN P«(-10) ELSE-CP=9) 
))<0 THEN ENR<-DECPT*0 ; 
E«-£+l* P<TENCABS(ENR-in#,HHl,ISO> i 
END i 



0298Q685 


T 


0510*1 


02980700 


T 


0510*3 


02980715 


T 


05121 3 


02980730 


T 


0514M 


02980745 


T 


0517*0 


02980760 


T 


0521*0 


02980775 


T 


0524*0 


02980790 


T 


0524*1 


02980805 


T 


0524*3 


02980820 


T 


0526*1 


02980835 


T 


0527*3 


02980850 


T 


0532*0 


02980865 


T 


0535*2 


02980880 


T 


0536*0 


02980895 


T 


0536*0 


02980910 


T 


0537*3 


02980925 


T 


0542*1 


02980940 


T 


0543*2 


02980955 


T 


0546*2 


02980970 


T 


0546*2 


02980985 


T 


0549*2 


02981000 


T 


0549*2 


02981015 


T 


0553*2 


02981030 


T 


0554*0 


02981045 


T 


0554*0 


02981060 


T 


0555*1 


02981075 


T 


0556*3 


02981090 


T 


0558*0 


02981105 


T 


0565*0 


02981120 


T 


0566*1 


02981135 


T 


0568*0 


02981150 


T 


0569*1 


02981165 


T 


0569*1 


02981180 


T 


0570*0 


02981195 


T 


0572*2 


02981210 


T 


0575*1 


02981225 


T 


0578*1 


02981240 


T 


0581*3 


02981255 


T 


0584*0 


02981270 


T 


0585*0 


02981285 


T 


0586*1 


02981300 


T 


0586*3 


02981315 


T 


0588*0 


02981330 


T 


0588*2 


02981345 


T 


0588*3 


02981360 


T 


0591*1 


02981375 


T 


059i«3 


02981390 


T 


0596*1 


02981405 


T 


0598*3 


02981420 


T 


0598*3 


02981435 


T 


0603*1 


02981450 


T 


0603*3 


02981465 


T 


0604*3 


02981480 


T 


0605*1 


02981495 


T 


0608*2 


02981510 


T 


0612*0 


02981525 


T 


0615*0 






ETYPEl* 



NOFIT: 
ETYPE2* 



DECPTsOfDUP) THEN RNDUP*0 } 

THEN ENR*0 

GO ZEROES END '> 
A8S(TVPE)s08LPREC 



IF PCRNDUP AND 

GETWDTH ; 

IF P THEN IF E«C-lO) AND MNTSSA<1 +HALF 

ELSE DECPT«-FNL*E = 9 ; 
IF MAXWDTH<SGN + OECPT + (E«-ENR) + HOTH THEN 
BEGIN IF NOT LSSl THEN GO OVRFLWJ 
ENR«-TRZ«-0 ; 

basiconvert; buffer ; 
streamcgtrmiifnr«-abs(fnr),s*fnr<0#c*if 



m 



FIVEPTS ! 

GET3* 

FUNNYE' 



ZEROES: 
FTYPEJ 



SETUP! 

IF 
IF 



THEN "D" ELSE «E M >8UFF) J 
BEGIN 

SULOC CI SI*Sl + 7J ds*chr; maybecs»l* m * m 5 ; 
si+lqc fnr; ds«-gtrmi dec; gtrmi*di * 

END i 
GO BACK } 
5.49755813885 ; 

pcusexpnotation^del) ; 

END * 
IF NOTCE/T2 OR GTRMl) THEN GO CHOOSEI * 
IF CENR*MS3-T3>>1 THEN GO ETYPE* DECPT*0 * 
IF NOT CCENR<*MS3>T3) OR RNDUP OR MNTSSA<1+HALF ) THEN GO 
GO ETYPE * 

WH1«-FNL«"0; IF SGN AND MAXW0TH*2 THEN GO MAXWDTHQFll FNR*T2 
P(WHlxTENCFNR]».WHl#ISD)l DECPT*! i 
IF -2<E AND WH1=TENCE*FNL+FNR3 THEN 

BEGIN FNUFNL + i; P ( TEN C ( E«-E + 1-DECPT*FNR>0 )M ] * , WH1 , I SO ) END) 
ENR<-TRZ*0; GO FITYPE > 
END » 
FNR+FNL LEQ T2 THEN GO FTYPE i 

LSSl SNO SGN THEN IF MAXWOTH«2 THEN GO MAXWOTHOFl ; 
PCRNDUP)* IF NOT FTEST THEN GO FTYpE ; 
GO FUNNYE ! 



NOFIT ; 



; 



maxwdthqfh 
e*o ; 

CHOQSElJ 

IF NOT GTRMI THEN 
TENCE'-E+llaWHl 



PCHH1»,WH1MSD> ; 

THEN GO GET3 i 
PCMAXWDTH=1*DUP) THEN SGN*SGN ANq WH1*0 * 
NOT CP AND CSGN OR WH1>9}> THEN GO ITYPE i 



IF 

IF 
IF 
OVRFLWS 

WDTh«-HAXWDTH; PCnID); NID*Ni; CHeCKBUMPANDSKIPJ 

strfam(svmaxwdth!s«-svmaxwdth, [36:63, buff) * 

begin svmaxwdth(ds<-lit"x»); sc 32c ds*2li t m x" ) ); svmaxwdth«-oi end; 

GO BACK ; 

END OF FORTRANFREEWRITE i 



NID*P ; 
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02981840 
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02982065 
02982080 
02982095 
02982110 

02982125 
02982140 
02982155 
02982160 
02982170 
02982185 



T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0613*0 
061783 
0619*0 
0622*2 
0625*2 
062881 
063080 
063181 

063282 
0635*1 
063782 
063782 
063982 
064082 
064083 
064l«l 
064380 
064481 
06448 1 
0646*0 
064980 
0652*2 
0653«1 
0657*1 
0659*2 
066283 
0668*2 
0670*1 
0670*1 
0672*0 
0674*2 
0676*2 
0677*0 
0677*0 
0677*3 
0677*3 
0679*2 
0682*0 
0685*1 
0687*1 
0687*1 
069i 82 

0693*2 
0696*3 
0697*2 



SIZE* 0698 WORDS 



^;^U^',-ii&" : '--i 



PROCEDURE FINNAME; 



COMMENT 






BEGIN 

filx 

FMTA 
LISX 



%154 



FILE TOP 10 DESCRIPTOR 
FORMAT OR NAMELIST OR 
ACCIDENTAL ENTRY DESc, OR 
i 



START OF REL 



02982500 
SEGMENT! DISK 
02982520 
02982540 
02982560 
02982580 
02982600 



T 0000*0 
ADDRESS * 



0000*0 
0000*0 
0000*0 
0000*0 

0000*0 



00427 





• 
* 

• 



ARRAY 
NAME 

INTEG 

REAL 

ARRAY 



NAME 
REAL 



•"1* 
~2> 
24* 
-3* 

"*6 f 

13* 

141 

2^ 

* 17; 
s 20; 

- IOC*]* 

a 22[*1> 



REAL 
NAME 
INTEG 



REAl, PARL 
EDEL 
EORTERR 
LISX 
FI 

OKAOR 
READINT 
SELECT 
FMTA 
FILX 
MEM 
ER JUNK! 

LISTYPE 

PRT8ASE 

TEN 

FIBC *3> 

listadr; 

BUFF 

BSIZE 

NBC# 

NLI#NLE#SBS* 

NFCI* 
OHl* 

WH1 
WH2; 
NAMEVJ 
H1J 
ER RPT* 
H 

WT 
Tl 
Dl 
D2 

CNT* 
EXP 

EXPSGN* 

NCR 

LCR 

CHR 
BOOLEAN DONETOG 
SGN 
LGT6* 
OTAERR* 
NLT* 
NFL* 

ctog; 
define logv 

iNTEGV 

OBLV 

CMPLXV 

SPC * 3#> 

NUM « ?Jp 

10 = 1#» 
KIND * CFIBC4].C8U])#, 

MAX = P7777777777777#* 

ELMTYP ~ LISTYPE . C«4M3## 

pLN * (LISTYPE. C44U3 * pBLV)#> 



FIRST BUFFER 
ARGUMENTS 



POSITION 



% FIELD 

% 

% 

% 

% 



WIDTH 



LA- 



CE' 



% EXPONENT 



% 
% 

% 
% 



CURRENT BUFFER POSITION 
BUFFER SIZE IN CHARACTERS 



RETURN 
SIGN 



AFTER WRITE 



a 4#j, 

»1## 

a 6## 



02982740 
02982760 
02982780 
02982820 
02982840 
02982860 
02982880 
02982900 
02982920 
02982940 
02982960 
02982980 
02983000 
02983020 
02983040 
02983060 
02983080 
02983100 
02983120 
02983140 
02983160 
02983180 
02983200 
02983220 
02983240 
02983260 
02983280 
02983300 
02983320 
02983340 
02983360 
02983380 
02983400 
02983420 
02983440 
02983460 
02983480 
02983500 
02983520 
02983540 
02983560 
02983580 
02983600 
02983620 
02983625 
02983640 
02983660 

02983680 
02983700 

02983720 
02983740 
02983760 
02983780 
02983800 
02983820 
02983840 
02983860 



T 

T 

T 

T 

T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 



0000»0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



m 
m 



m 
m 



£ 



• 



LABEL 
COMMENT 
SUBROUT 
BEGIN C 
LCS + 8 
BUFF <- 
END CKP 
SUBROUT 
BEGIN 
PCMKS»D 
IF DONE 
IF C(*F 

ckpb; 

END REA 

BOOLEAN 
ARRAY A 
INT 
DEFINE 

SUBROUT 

BEG 



CMPLX 
TWOD 
SIZFF 
BASEF 



* CLISTYPE, C44S4 

* LISTYPE. C 38* 13 

o [33*153#> 

« C18$153#; 



nm|_st#nlerr'nlp#nlpa#nrp*n 
***** start of subrout 
ine ckpb; 

omment initialize file and 
xcbshe <- pcmks*dkadr»1*filx 
c*filx). [33515]; ncr * oj 

b; 

ine reads; 

kadr*o»filx*readint); 
tog then pcxit); 
ilx).C27ji3) then pcxit); 



3 « cmplxv)#» 



lisrt*nll*nlpb#nrpl; 

ine declarations ********; 

acquire record size; 

,READINT)); 



END 

SUiRCUT 

BEG 



ds; 

% 
AT 
Rl 
FGE 

NXT 

INE 

in; 
s 

B 



E 

N 

W 

SK 

INE 

IN 
I 



parameters for list cont 
og*twdt; 

s LISTADRC*]; 

r inox, size; 
elm = if twot then p(*lar 
else carici 
skpc; x skips current 

% IN NBC 
TREAMcPl«-BUFF'P2*0*P3«-0); 
EGIN 

si «• pi i si <- si + i; 

01 «■ loc p2; di «• di + 
no; 
bc ♦ p; BUFF + p; 

T «■ WT -1' 

pc; 
scale; 



ROL 



l[lNDX.r33!?3 3 3*INDX t CAO)83,CDC) 

N0XJ3#; 

CHARACTERS, PUTS NEXT CHARACTERS 



pi * si; 

7} DS *- CHRI 



NT3»TENC69+CNT3*x, 

*WH2) 

1/ 



END 

SUBROUT 

BEG 



D 
SC 

INE 

in; 
s 

8 



F CD1 ♦ 01 + CNT3 > 11 
THEN 00UBUECWHWWH2#TENtC 
0H1*0#+»*»WH1 
ELSE WH1* WH1XTENCCNT3+DH 
HI ♦ o; 
ale; 
getnum; 



TREAM(P1<-BUFF#P2*IF WT S 8 TH£N WT ELSE 8#P3*0* P4*0 * P5*0 ); 
EGIN 



si * pi; 

P2CIF Sc s " " THEN T 

ELSE 
BEGIN IF SC * M Q" 
ELSE JUMP OUT; 

end; 

S'l «■ SI + i)J 

P2 «- tally; 

si * pi; di ♦• loc P3; 

pi *• si; 

DI «■ LOC P4; DI * DI 



ALLY <• TALLY +1 
THEN TALLY * TALLY ♦ 1 



DS * P2 oct; 
+ 7; ds * chr; 



02983880 T 
02983900 T 
02983920 T 
02983940 T 
02983960 T 
02983980 T 
02984000 T 
02984020 T 
02984040 T 
02984060 T 
02984080 T 
02984100 T 
02984120 T 
02984140 T 
02984160 T 
02984280 T 
02984300 t 
02984320 T 
02984340 T 
02984360 T 
02984380 T 
02984400 T 
02984420 T 
02984440 T 
02984460 T 
02984480 T 
02984500 T 
02984520 T 
02984540 T 
02984560 T 
02984580 T 
02984600 T 
02984620 T 
02984640 T 
02984660 T 
02984680 T 
02984700 T 
02984720 T 
02984740 T 
02984760 T 
02984780 T 
02984800 T 
02984820 T 
02984840 T 
02984860 T 
02984880 T 
02984900 T 
02984920 T 
02984940 T 
02984960 T 
02984980 T 
02985000 T 
02985020 T 
02985040 T 
02985060 T 
02985080 T 
02985100 T 



ooooto 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
OOOilO 
000l»0 
000313 
0006«0 
0006*1 
0007*0 
0007*0 
0008*1 
0009*1 
0011*0 
0012*0 
0012*1 
0012*1 
0012*1 
0012*1 
0012;i 
0012*1 
0012*1 
0013*0 
0013*0 
0014*2 

0014*2 
0015*1 
0016*0 
0016*1 
0017*1 
0018*2 
0018*3 
0019*0 
001910 
0020*1 
0023*3 

0025*1 
0028*0 
0028*3 
0029*0 
0029*0 
0029*0 
0033*0 
0033*0 
0033*1 
0034*1 
0034*3 
0035*1 
0036*1 
0036*1 
0036*3 
0037*0 
0038*0 
0038*1 






c 



• 
• 






end; 

NBC *■ P'p DH1 «■ p; CNT «- p; BUFF *■ P; 

END getnum; ^ 

SUBROUTINE GETSIGN; 
BEG IN J 

STREAMCPl*BUFF.P2*(IF WT > 63 THEN 63 ELSE WT) ,P3*0,P4-< -1) * 

BEGIN 

SI*PU Di*P2 ; 

P2(DI*DI-8; IF SCX W " THEN JyMP OUT TO UJ 
SI * SI + l| TALLY «- TALLY + 1)1 

pi + si; 

go to rtnsgn; 

LH IF SC £ "0" then 

BEGIN 

L3J P2 «- TALLYI 

L2* P5CPK-DH TALLY*P2; PlCIF SCX" « THEN 

jump out; tally-tally*!; si-si + n; p2-tally); ph-si ; 
oi «- loc P4I os * 7 lit "o"; os * chr; 
go to rtnsgn; 
end; 

if sc ■"," then go to l3i 

TALLY <- TALLY+ll 

P2 * tally; 

TALLY*l; P5*TALLY ; 

IF SC*"*" THEN TALLY+1 ELSE IF SC* M +" THEN TALLY*0 FI SF 

IF SC=»&» THEN TALLY-0 ELSE TALLY*0 ELSE 

„. BE 5f N 3 AL -i-Y<-o; pi-tally; go to rtnsgn end; 
p3 «• tally; 

Si «■ SI + l; 
GO TO L2; 
RTNSGN: 

end; 

NBC-P; SGN-p; CNT-PI DTAERR«.(CBUFF«.p>sO) ; 

end getsign; 
label ncrtn^blsgn; 
subroutine numconvertj 

BEGIN 

DH1 8s 01 * = 02 * = EXP !s EXPSgN j* 0| 

WHl - WH2 ♦ -o; 

wt - w; 
blsgni 

getsign; 

if dtaerr then go to ncrtn i 

WT - WT - CNT! IF NBC <0 % BLANK FIELD 

IF T NBC S F 9 W THEN° ™ EN G ° T0 N ° RTN Z ^ Z G ° T ° BLSGN ' 

begin 

getnum; whi * dhi; 

IF (WT - WT - (Dl - CNT)) < THEN GO TO NCRTN; 
WHILE NBC < "9" OR NBC s " " Dn 
BEGIN 

getnum; scale; 

IF (WT - WT^CNT) < THEN GO TO NCRTNI 
END ; 
END; 

IF NBC * "." THEN 



02985120 T 
02985140 T 
02985160 T 
02985180 T 
02985200 T 
02985220 T 
02985240 T 
02985260 T 
02985280 J 
02985300 T 
02985320 T 
02985340 T 
02985360 T 
02985380 T 
02985400 T 
02985420 T 
02985440 T 
02985460 T 
02985480 T 
02985500 T 
02985520 T 
02985540 T 
02985560 T 
02985580 T 
02985600 T 
02985620 T 
02985640 T 
02985660 J 
02985680 T 
02985700 T 
02985720 J 
02985740 T 
02985760 T 
02985780 T 
02985800 T 
02985820 T 
02985840 T 
02985860 T 
02985880 T 
02985900 f 
02985920 T 
02985940 T 
02985960 T 
02985980 T 
02986000 T 
02986020 T 
02986040 T 
02986060 T 
02986080 T 
02986100 T 
02986120 T 
02986140 T 
02986160 T 
02986180 T 
02986200 T 
02986220 T 
02986240 T 



003910 
0039*1 
004i»l 

0041*2 

0042»0 

0042*0 

0045*2 

0046*1 

0046*1 

0046*3 

0048*2 

0049* 1 

0049*? 

0049*3 

0050*1 

0050*1 

0050*2 

0053*0 

0055*0 

0056*3 

0057*0 

0057*0 

0057*3 

0058*0 

0058*1 

0058*3 

0060*3 

0061*3 

0062*2 

0062*3 

OO6310 

0063*1 

0063*1 

0063*2 

0066*2 

0066*3 

0066*3 

0067*0 

0067*0 

0069*3 

0071 *1 

0072*0 

0072*0 

0073*0 

0074*0 

0075*3 

0078? 1 

0079*0 

0079*2 

0081*3 

0084*2 

0086*3 

0086*3 

0089*0 

0091*1 

0091*3 
009i 8 3 



i 
i 
i 
1 
1 
i 






a ' 



BEGIN 



• 



PEG IN 



end; 
end; 



skpc; 

if wt<0 then go to ncrtn } 

while cnbc $ «9 m ) or (nbc = " « ) do 

getnum; SCALE) 
D2 «■ D2 + CNT; 
IF C WT *■ WT - CNT) -S THEN GQ TO NCRTN; 



IF NBC * "0" OR N8C = "E" THEN SKPC; 

IF WTSO THEN BEGIN DTAERR«-TRUE; GO TO NCRTN END > 

IF CNBC = " + ") OR (NBC^'S") OR CNBC*" w ) OR (EXP§GN«-( NBC*"-" ) ) 

THEN SKPCJ 
IF WT<0 THEN BEGIN DTAERR«-TRUE; GO TO NCRTN END i 
IF NBC > "9" THEN QTAERR #• TRUf 
ELSE 
BEGIN 

getnum; 

exp •■ if expsgn then cdh1) else qh1j 
if (wt*-wt-cnt5 < then go to ncrtn; 
if not nlt then while wt > do skpc; 

end; 

NCRTN: 

IP WHl = THEN IF SGN THEN WH1 * -0; 
END NUMCONVERT' 
LABEL NMBLNk; 

real subroutine nmscn; 
begin; 

NMBLNK: 

IF NCR > LCR THEN READS; 
STREAMCPl«-BUFF,P2«-(IFCTl«-LCR-NcR)>63 THEN 63 ELSE U), 

P3 *0IP44-0)I 
BEGIN 

Si «-pi; 

P2CIF S C /" " THEN JUMP OUT TO UJ 

si * si + i; tally ♦ tally + in; 
P2 «- tally; tally * 1; 

GO TO L2; 

Li: P2 *■ tally; tally «• o; 
L2s pi <■ tally; p3 «- si; 
end; 

8UFF <■ P; NCR *• NCR + P; IF P THfN GO TO NMBLNK; 
STREAM(Pl<-BUFF>P2«-0,P3«-0,P4«-» "#P5«-0*NFL> ; 
BEGIN 

SI * pi; 

NFLCIF SC^O" THEN JUMP OUT TO NU) ; 
IF SC a ALPHA THEN 
BEGIN 

DI * LOC PA; DI ♦ DI + 2} 
6CIF SC < "A" THEN JUMP OUT; 

ds «- chr; tally ♦ tally + n; 
Pi * si; P3 <- tally; 
tally * i; go to exit; 

end; 

NFLCIF SC/ M -" THEN IF SCJ"' + " THEN IF SC*"&" THEN JUMP OUT; 
JUMP OUT TO NU) ; 



02986260 


T 


0Q92»2 


02986280 


T 


0093»0 


02986300 


T 


009480 


02986320 


T 


0095*1 


02986340 


T 


0097?2 


02986360 


T 


009712 


02986380 


T 


0100»0 


02986400 


T 


oiom 


02986420 


T 


0103*2 


02986440 


T 


0104*0 


02986460 


T 


0104*0 


02986480 


T 


0107*0 


02986500 


T 


0109*2 


02986520 


T 


0113*0 


02986540 


T 


0115*0 


02986560 


T 


0117*2 


02986580 


T 


0119*0 


02986600 


T 


0119*2 


02986620 


T 


0120*0 


02986640 


T 


0121*0 


02986660 


T 


0123*2 


02986680 


T 


0125*3 


02986700 


T 


0129*2 


02986720 


T 


0129*2 


02986740 


T 


0129*2 


02986760 


T 


0132*2 


02986780 


T 


0132*3 


02986800 


T 


0132*3 


02986820 


T 


0133*0 


02986840 


T 


0133*0 


02986860 


T 


013350 


02986880 


T 


0135*0 


02986900 


T 


0138*3 


02986920 


T 


0139*3 


02986940 


T 


0139J3 


02986960 


T 


0140*0 


02986980 


T 


0141*2 


02987000 


T 


0142*1 


02987020 


T 


014253 


02987040 


T 


0143*0 


02987060 


T 


0143*2 


02987080 


T 


0144*0 


02987100 


T 


0144*1 


02987120 


T 


0146*2 


02987140 


T 


0148*3 


02987160 


T 


0148*3 


02987180 


T 


0149*0 


02987200 


T 


0150*3 


02987220 


T 


0151*1 


02987240 


T 


0151*1 


02987260 


T 


0151»3 


02987280 


T 


0153?0 


02987300 


T 


0153*3 


02987320 


T 


0154*1 


02987340 


T 


0154*3 


02987360 


T 


0154*3 


02987380 


T 


0156*3 



€ 



i 



• 
# 



tally ♦ 1; P3 * tally; 

DI «- LOC P2; di * di + 7; 

IF SC *«#" THEN BEGIN DS«-t_ I T"* M ; S I <- S I + 1 END ELSE 

IF SC *"[" THEN BEGIN DS«-|_IT *')"; SI * SI + 1 END ELSE 

IF SC *"%" THEN BEGIN DS*LlT "C"J SI «• SI + 1 END ELSE 

DS *CHRJ 
PI ♦ SIj 

TALLY «- 3; GO TO EXIT; 



NU* 



PI «• Si; TALLY * 2; 
EXIT! 

P5 «• tally; 
end; 

tl * p; namev + p; ncr * ncr + p; nbc «• pi buff * pi 
if tl * id then nbc * namevi 

NMSCN «• Tli 
END NMSCNJ 
SUBROUTINE NLCONVJ 
BEGIN 

if nbc ■ "." then 
begin; 

stream(p1«-buff8p2*0); 

BEGIN DI * Pi; DI ♦ DI * it PI * Oil END! 
BUFF * p; NCR <• NCR • 1 J 

eno; 

h «■ lcr~ncr; 

numconvert; 

if (ncr «■ ncr + (w-wt)) > lcr then reads! 

Tl * EXP - D2I 
IF WH1 > MAX 

THEN 
IF Tl > THEN D0UBLECWH1,WH2*TEN[TI]*TENC69+Tn,x, 

*»WH1#WH2) 
ELSE DOUBLE C WH 1 # WH2> TEN fT 13, TEN [69-Tl]*/* 
«-*WHl*WH2) 
ELSE 
IF Tl > THEN WH1 * WHl x TENfTl] 

ELSE WHl «■ WHl / TENC-T13; 
IF SGN THEN WHl * ■- WHi* 
END NLCONV; 
LABEL NLR'SUBD; 
SUBROUTINE SU8EVUL; 
BEGIN 

IF NMSCN XIMUM THEN GO TO NLERR; 
CHR * FMTACNLI*NUI + n f tH63i % # DIM 
NFCI *■ U NLCONV; 

IF (D2*0> OR (EXP i 0) THEN GO TO NLERR; 
SBS «* WHl-U 
NLR: IF NMSCN X SPC THEN GO TO NLERR; 
IF NBC * ")" THEN GO TO SUBD; 
IF NFCI * CHR THEN GO TO NLERR; 
NLCONVI 



02987400 
02987420 

02987440 

02987460 

02987480 

02987500 

02987520 

02987540 

02987560 

02987580 

02987600 

02987620 

02987640 

02987660 

02987680 

02987700 

02987720 

02987740 

02987760 

02987780 

02987800 

02987820 

02987840 

02987860 

02987880 

02987900 

02987920 

02987940 

02987960 

02987980 

02988000 

02988020 

02988040 

02988060 
02988080 
02988100 

02988120 
02988140 
02988160 
02988180 

02988200 
02988220 
029882^0 
02988260 

02988280 
02988300 
02988320 
02988340 
02988360 
02988380 
02988400 
02988420 
02988440 
02988460 
02988480 
02988500 
02988520 



T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



Ol58'0 

0158*0 

0158«0 

0158*0 

0158*2 

0159*0 

0160*2 

0160*2 

0162*0 

0163*2 

0163*3 

0164*0 

0164*2 

0164*2 

0164*2 

0165*0 

0165*0 

0165*1 

0165*2 

0168*2 

0170*2 

0171*0 

0173*0 

0173*0 

0173*0 

0173*3 

0174*1 

0175*2 

0176*2 

0178*1 

0178*1 

0179*2 

0181*0 

0185*0 

0186*1 

0186*3 

0187*0 
0191*1 

0192*0 

0196*3 

0197*2 

0197*3 

0200*0 

0203*1 

0205*0 

0205*1 

0205*1 

0206*0 

0206*0 

0208*0 

0210*2 

0212*0 

0214*2 

0215*3 

0218*0 

0219*1 

0220*2 



m 



m 



m 
m 






« » 



€ 



IF (02*0) OR (EXPXO) THEN GO To NLERR,* 

WHl * WH1 " 1) D2 ♦ OJ 

WHILE D2<NFCI DO WHl «• WHlxFMTA CNLI + (D2<-D2 + l ) 3 i 

S8S ♦ SBS + whi; 

NFCI * NFCI + i; 
GO TO N|_R> 
SUBD* 

inox * inox + sbs; 

ti <• nmscn; 
end subevul; 
comment ********** end qp declarations *■■*******■##-*; 
nfl*i ; 

filxcnot 43 * eofl; FlLX[NOT 33 <- parl; 

FIB «- FILXCNOT 23; % OPEN FILE IF NOT OPEN 
IF FIBC53, [43*23 X (Tl * 2 ) THEN 

p«mks#0»t1#filx#1» select); 

* set/check for mixed formatted - unformatted j/0 
ckpb; 
if fi8c03 = then fib[03 j= 1 else 

IF FIBCO] NEC 1 THEN P ( MKS,F IB [ 6 3 ,F ILX , [ 33 * 15 3 #4,FQRTERR ) * 
NMLSTS 

NLE * FMTACFI].t2ll03; 

nlt «• true; 

skpc; NCR * NCR + 1; 

WHILE NMSCN X SPC OR NBC X «S" 00 BEGIN READS; SKPC; END; 

NCR * NCR + i; 

IF NMSCN X ID THEN GO TO NLERR; 

IF FMTACFI3. [12*363 X NBC THEN 

begin reads; go ro nmlst; end; 

IF NMSCN X ID THEN GO TO NLERR; 



NLP 
NLPAJ 



BEGIN 



END; 



NLPB» 



BEGIN 



end; 



nli * fi + i; ti «■ nle; 

WHILE Tl >0 DO 

I 

IF NBC = FMTA[NLI3,C12*363 THEN GO TO NLPB; 

ti *■ ti - i; 

NLI * NLI + 2 + FMTA[NLI + U.C1 $6]; 

% NOT FOUND 
WHILE (Tl* NMSCN) X SPC OR(NBC X »," AND NBC X ♦•$") DO 

IF Tl - NUM THEN NLCONV; 
IF NBC « "S" THEN BEGIN DONETOG ♦ TRUE; READS END; 
GO TO NLP; 

ATOG <■ CTOG * FALSE; 

LISTYPE «■ FMTA[NLI3.[2J103; 

IF CT1<-FMTACNLI + 13. [18:303 ) XO THEN 

SIZE«-UNDX*Tl.BASEF)+Tl*SIZEF ; 

atog * true; 

IF (Tl <• FMTA[NLI + U f C7M13) < 1024 THEN 
LISTADR * [PRT8ASE[T133 
ELSE LISTA0R «- IF Tl. [39:13 THEN [MEM [L I SX<-T 1 , [ 41 * 73 3 3 

ELSE [MEM[LISX+Ti, [40*8333; 
IF ATOG THEN TWDT«-N0T P ( * ( L I ST ADR*MEM [ ( * [L ISTADR 3 ) , [ 18 * 153 3 ) * 

TQP'XCH'DEL) 



02988540 
02988560 
02988580 
02988600 
02988620 
02988640 
02988660 
02988680 
02988700 
02988720 
02988740 
02988745 
02988760 
02988780 
02988800 
02988820 
02988860 
02988880 

02988900 

02988920 

02989000 

02989020 

02989040 

02989060 

02989080 

02989100 

02989120 

02989140 

02989160 

02989180 

02989200 

02989220 

02989240 

02989260 

02989280 

02989300 

02989320 

02989340 

02989360 

02989380 

02989400 

02989420 

02989440 

02989460 

02989480 

02989500 

02989520 

02989540 

02989560 

02989620 

02989640 

02989660 

02989680 

02989700 

02989720 

02989740 

02989745 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 



0222*0 

0224*2 

0226*2 

0231*1 

0232*2 

0233*3 

0234*1 

0234*1 

0235*2 

0237*2 

0237*3 

0237*3 

0248*0 

0251*2 

0253*1 

0255*1 

0257*1 

0257*1 

0258*0 

0260*3 

0264*3 

0264*3 

0266*1 

0267*0 

0269*1 

0274*2 

0275*3 

0278*0 

0279*2 

0281*2 

0284*0 

0284*0 

0286*0 

0287U 

0287*1 

0289*1 

0290*2 

0293*2 

0294*0 

0294*0 

0298*2 

0301*2 

0305*0 

030552 

0305*2 

0306*3 

0308*1 

0310*3 

0311*1 

0314*0 
0314*3 
0314*3 
0317*1 
0318*1 
0324*0 
0326*3 
0330*1 










else wi*listadr ; 

if lgtg=0 then tunmscn else begin nbolgtgj lgtg*0 end; 

if nbc =*'(" then 

BEGIN 

if not atog then go to nlerr; 
subevul; 
end; 

IF NBC * "*" THEN GO TO NLERR; 

Tl * nmscn; 

NRP: IF Tl =NUM THEN 
BEGIN 

nlconv; 

if nmscn xspc then go to nlerr; 
if n8c * "*" then go to nlisrt* 
RPT * whi; 

if cd2*0) or (exp/0)then go to nlerr; 
if nmscn = num then go to nrp; 
end; 

NRPf* 

IF NBC - "." THEN 
BEGIN 

IF ELMTYP * LOGV THEN 
BEGIN 

nlconv; Tl ♦ nmscn; go to nlisrt; 
end; 

ti * nmscn; 

NLL» WH1 *• CNBC.tJ2*63* "T M ); 

WHILE (T1«-NMSCN) t SPC OR CNBC*"$" AND NBC * "#"} 

DO IF Tl* NUM THEN 60 TO NLERR; 
GO TO NLISRT; 

end; 

IF NBC »"(" THEN 
BEGIN 

if nmscn t num then go to nlerr; 

nlconv; junki «-whi; 

ctog * true; 

if nmscn * spc or nbc * "»" then go to nlerr; 

if nmscn /num then gq to nlerr; 

nlconv; 

wh2 «■ whi; WHI «■ junki; 

IF NMSCN i SPC OR NBC * " ) M THpN GO TO NLERR* 

go to nlisrt; 
end; 

if elmtyp /logv then go to nlerr; 
go to nll; 

NLISRT! 

IF ATOG THEN 
BEGIN 

IF INDX > SIZE THEN GO TO NLERR; 

wi ♦• nxtelm; 

indx <- indx+ (dln or cmplx); 

INDX «- INDX + i; 
END; 

IF ELMTYP ■ INTEGV THEN W1COWH1 DIV 1 ELSE 

WHO] *■ whi; 

IF (DLN OR CMPLX) THEN WlCl 3 «-WH2; 

IF NOT CCTOG £QV CMPLX) THEN GO TO NLERR; 



02989750 


T 


033i«0 


02989760 


T 


033380 


02989780 


T 


0337*2 


02989800 


T 


0338*1 


02989820 


T 


0338*3 


02989840 


T 


0339*2 


02989860 


T 


034110 


02989880 


T 


034110 


02989900 


T 


0342*1 


02989920 


T 


034312 


02989940 


T 


0344*1 


02989960 


T 


0344*3 


02989980 


T 


0346*0 


02990000 


T 


0348*0 


02990020 


T 


0349*1 


02990040 


T 


0350*0 


02990060 


T 


0352*2 


02990080 


T 


0355*0 


02990100 


T 


0355*0 


02990120 


T 


0355*0 


02990140 


T 


0355*3 


02990160 


T 


0356*1 


02990180 


T 


0357*2 


02990200 


T 


0358*0 


02990220 


T 


0361*0 


02990240 


T 


0361*0 


02990260 


T 


0362*2 


02990280 


T 


0364*1 


02990300 


T 


0367*1 


02990320 


T 


0370*1 


02990340 


T 


0370*3 


02990360 


T 


0370*3 


02990380 


T 


0371*2 


02990400 


T 


0372*0 


02990420 


T 


0374*0 


0299044Q 


T 


0375*3 


02990460 


T 


0376*2 


02990480 


T 


0380*1 


02990500 


T 


0382*0 


02990520 


T 


0383*0 


02990540 


T 


0384*2 


02990560 


T 


0388*1 


02990580 


T 


0388*3 


02990600 


T 


0388*3 


02990620 


T 


0390*2 


02990640 


T 


0391*0 


02990660 


T 


0391*0 


02990680 


T 


0391*1 


0299070Q 


T 


0391*3 


02990720 


T 


0393*0 


02990740 


T 


0397*2 


02990760 


T 


0401*1 


02990780 


T 


0402*2 


02990800 


T 


0402*2 


02990820 


T 


0405*2 


02990840 


T 


0406*3 


02990860 


T 


0411*2 



» » 



IF ATOG THEN IF (RPT <• 
NFL*0; WHILE NBCX'S" AND NBC/"$" 
IF NBC = »$ M THEN BEGIN DONETOG * 
IF NOT ATOG THEN GO TO HLP} 
IF ELMTYP / LOGV THEN IF (NMSCN »ID 
THEN GO TO NLPA ELSE IF NBC*"*" 
ELSE BEGIN WH1*WH2«-0J GO TO 
IF CT1 «■ NMSCN) * NUM THEN GO TO 
IF NBC = 'V THEN GO TO NRPL* 
WH1 * NBC* Tl * NMSCN* 
IF NBC X "*" THEN 



rpt-1) > then go to nlisrt; 

do pcnmscn»oed* nflm 
true; reads; end; 



) 

then go to nrp 
nlisrt end; 
nrp; 



BEGIN 

end; 

NLERR 
END F 



LGTG <- NBC; NBC * HH1J GO TO NlPA/ 

WH1 * C WH1 • C 12 163 * "T")j 
GO TO NLISRT; 

* 

P(MKS,FIBC6],FILX,C33{15],1,FQRTERR); 
INNAMg;; 



02990880 
02990900 

02990920 
02990940 
02990960 
02990980 
02991000 
02991020 
02991040 
02991060 
02991080 
02991100 
0299H20 
02991140 
02991160 
02991180 
02991200 
02991220 
02991240 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0413*3 
0416*3 
042212 
0426*0 
042613 
0430»1 
043113 
0434*0 
0436*2 
0437*3 
0440*2 
0441*1 
0441 »3 
0443*3 
0443*3 
0445*2 
0446*0 
0446*0 
0448*0 



SIZE* 0449 WORDS 



PROCEDURE FOUTNAME; 

BEGIN 
COMMENT FILX 
FMTA 
LISX 



*155 



START OF REL 



FILE TOP 10 DESCRIPTOR 
FORMAT OR NAMELIST OR 
ACCIDENTAL ENTRY OESc. OR 



REAL 



ARRAY 

name 

REAL 

INTEGER 
REAL 



ARftAY 



NAME 
REAL 



FORTERR 
LISX * 
FI s 
DKADR « 
FMTA s 
FILX = 
MEM = 
ALGOLWRITE 
SELECT 
LSTRN 
LISTYPE 
ARRAYSTUFF 
NAMEV 
PRT8ASE 
TEN 
TPAR 

fibc*i; 
listadr; 

BUFF 

BSIZE 

FLG 

WH1* 

WH2 

HI 

W2 

NFCI 



24* 
"1* 
-3* 

-4; 
-2C*3# 

-5* 
2; 

■ 12* 



FPB = 3C*3 



14; 

19; 

20* 

18* 

21; 

10 C *3 # 

22t*3* 

23[*3* 



, x first Buffer position 

* % ARGUMENTS 
, % TRUE FQR serial I/O 



* 
» 
p 
* 



% 



% NEXT FORMAT CHAR LOCATION 



02991260 

segment; DISK 

02991280 
02991300 
02991320 
02991340 
02991460 
02991500 
02991520 
02991540 
02991560 
02991580 

02991600 
02991620 
02991640 
02991660 
02991680 
02991700 
02991720 
02991740 
02991760 
02991780 
02991800 
02991820 
02991840 
02991860 
02991880 
02991900 
02991920 
02991940 
02991960 
02991980 
02992000 



T 0000*0 
ADDRESS « 



T 
T 
T 

T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 



©0442 



n 



INTEGER 






BOOLEAN 



DHl 

DH 2 

DH3 

W 

WT 

Tl 



OT 

01 

02 

3 

ZEROS 

EXP 

SHFT 

eooE 

SKP 
NCR 
LCR 
CHR 
D0NET0G 

sgn 

PRNTR 

DTOG 

CTOG 



CONV- 
ERTED 



% 

% 

% 

% FIELD 



NU- 



MBER 



WIDTH 



DEC" 



IMAL 



,% TRUE IF 



DEFINE 



LABEL 
COMMENT 
SUBROUT 
BEGIN C 
LCR * 8 
IF PRNT 

IF B 
IF PRNT 
BUFF ** 
IF ((NO 
STREAMC 



LOGV 

INTEG 

D8LV 

CMPLX 

E^YPE 

DTYPE 

ITYPE 

LTYPE 
ELMTY 
DLN 
CMPLX 
TWOO 
ENDLI 
SIZEF 
ERTN, 
* * 

INE C 
OMMFN 
xCBSl 
R + PRN 
.tl 
SIZE 
R AMD 
(IF T 
T Tl) 
P2 *• 
P3 



BEGIN 



end; 

NCR «• 0, 



DI 
SI 
P2 
OS 



ST 

* * * S 

kpb; 

T INIT 
ZE <- P(M 
TR&(((T1 
3M13 + 3] 
GEO 17 T 

BSIZE=1 
1 s= PRN 

OR PRNT 

CBSIZE-1 
♦T1.C47I 

* P4J 
f- P4I 

(DS <■ 32 
«• P3 WD 



4#> 
1#* 
5«# 

6*, 

3## 

Hit, 

5#, 

6## 
LISTYPE , C 
(LISTYPE, C4 
(LISTYPE. U 
LISTYPE. C 38 
(LSTRN b (- 
C33U53#J 

>AST>C0MM,NM 

TART OF SUBR 



% 

% 

% 

% 

X 

% TRAILING 

% EXPONENT 

% INTEGER 

% EDITING 

% REDUNDAN 

X CURRENT 

% BUFFER S 

% CURRENT 

% RETURN A 

% SIGN 
PRINTER OUT P 

% DOUBLE P 

% COMPLEX 



LA» 

CE- 
S 

zeroes 

part of shift 
function 
t positions 
buffer position 
ize in characters 
char from format 
fter write 

UT 

RECISIGN TOG 

NUMBER TOG 



IALIZE 
KS,FLG 
♦FIBU 
. t * 3 5 5 
HEN BE 
7 THEN 
TR THE 
R.C46S 
).C36! 
U+BSI 
DS «■ 

wds; 
s; 



FILE 
>DKADR 
),C8U 
3<20)[ 

GIN LC 

LCR«-1 

N TPAR 

13) TH 

ZE-1#P 

8 LIT 

DS * 



44!43*# 

4843 =ORLV)#> 

4543 « CMPLXV)## 

!13## 

!)■)#* 

i^nm2»fmerr; 

outine declarations * * * * *■*■* * i 

and acquire record size/ 

>0>(-l),FILX#ALGOLWRlTE))J 

3)M OR Tl«7 OR T1=12) AND FPBCFIBUJ 

47147113 THEN 

R »s 132^ BSIZE 5 = 17 END; 

20 ; 

ELSE *FlLX).E33ilS3; 

EN 



4*6UFF) '* 
32 WDS); 



02992020 
02992040 

02992060 
02992080 
02992100 
02992120 
02992140 
02992160 
02992180 
02992200 
02992220 
02992240 
02992260 
02992280 
02992300 
02992320 
02992340 
02992360 
02992380 
02992400 

02992420 
02992440 
02992460 
02992480 
02992500 
02992520 
02992540 
02992560 
02992580 
02992600 
02992620 
02992640 
02992660 
02992680 
02992700 
02992720 
02992740 
02992760 
02992780 
02992800 
02992820 
02992840 
02992860 
02992880 
02992885 
02992900 
02992920 
02992960 
02993020 
02993040 
02993060 
02993080 
02993100 
02993120 
02993140 
02993160 
02993200 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 



OOOO'O 
0000*0 

000050 
000050 
0000»0 
000050 
000050 
000050 
000050 
000050 

ooooso 

000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
000050 
0000 5 
000050 
000050 
000050 
000050 
000Q50 
000150 
000150 
000452 
000950 
001350 
001651 
001853 
002252 
002fl50 
002650 
0028»1 
002953 
003050 
003151 

003153 
003250 



€ 

i 



« 



• 
• 



9 



» ♦ 



i 



end ckpb; 
subroutine prnt/ 
begin comment 
if prntr then 
begin; 

ncr * o; 

STREAM(P1*0:P2«-TPAR)J 
BEGIN SI «.P2J DI ♦ LQC 



GENERATE A CALL FQR CAR, CONT, AND FOR OUTPUT* 



DI *• P2; 
NCR ♦ P> 
IF NCR = " " 
NCR = "0" 
NCR * "+" 
IF (D2 



DS «■ LIT 



pi; di ♦di 

w w ;end; 



♦ 7; ds ♦chr; 



IF 
IF 



THEN D2 ♦ 16 ELSE 
THEN D2 ♦ 32 ELSE 
THEN D2 ♦ ELSE 
■ NCR) > 9 THEN 02 ♦ 16; 
IF NOT PRNTR f [A6lU THEN FIBC 17 3 ♦FIB[ 17 3+BSIZE ; 
PCMK5»D2»U2l23*D2,C44l4j*PRNTR.[46ll]#BSIZE»FIlX*ALG0LWRlTE) 
FIBC63*FIBC6]-(D2' S 05 J 

IF NOT (*FILX). U9*13 THEN P CF ILX# 92000000000, 2* COM* DEL* DEL ) ; 
P.RNTFUU CK'PB I 

STREAMCP1*TPAR*P2**FILX*P3*BSIZE,C36»63#P4*BSIZE)^ 
BEGIN 

SI ♦ Pll DI «• P2/ DS «- P4 wds; 
P3CDS *32 WDS; DS * 32 WDs>J 

di*pi> P4CDS*8LiT" ♦') ; 
End; 
fib[17]*fibc173-bsize; if donetog then pcxit) ; 

END ELSE BEGIN P<MKS> FLG, DKADR, 0* BSlZE* FILX# ALGOLWRI TE ) '> 

IF donetog then Pcxm; 

CKPB END ; 
END PRNT* 

% parameters tor list control 
boolean atog#twot; 
array ari * listadrc*3j 
real indx,size*nli*nle; 
label rtnlst'srt; 
define nxtelm b if twdt then 

ELSE 

subroutine getnmlst; 

BEGIN 

IF cnle ♦ nle - 1) 

BEGIN 

NAMEV <- FMTACNLI* NLI + 1 3 , C 12 * 36 3 ; 
LISTYPE ♦ FMTA CNLI 3 • C2: 103; 
ARRAYSTUFF * FMTACNLI*NLl+l].Ci8l303; 
IF CT1 ♦ FMTACNLI 3 , C7: 1 1] ) < 1024 
THEN LISTADR^ C PRTB ASEC Tl 3 3 ELSE 



PC*CAR1CIN0X,[33I7]3]#INDX,C40I8]*C0C) 

AR1UNDX3#; 



<0 THEN LSTRN ♦• - 1 ELSE 



IF T1.C39U3 
NLI ♦ NLI * 

end; 

end getnmlst; 
subroutine getlist* 

BEGIN 

SRTs IF ATOG THEN 

BEGIN 

IF DLN THEN 
BEGIN 



THEN LISTADR * C MEMt LI SX-C T 1 , t 4 1 : 7 3 > 3 ] 

ELSE LISTADR ♦ [M C M[ LISX+CT 1 , [40 > 83 ) 3 3 i 
FMTA[NLI3.US6]; 



02993220 

02993240 

02993260 

02993280 

02993300 

02993320 

02993340 

02993360 

02993380 

02993400 

02993420 

02993440 

02993460 

02993480 

02993520 

02993540 

02993560 

02993580 

02993600 

02993620 

02993640 

02993660 

02993680 

02993700 

02993720 

02993740 

02993760 

02993780 

02993800 

02993820 

02993840 

02993860 

02993880 

02993900 

02993920 

02993940 

02993960 

02993980 

02994000 

02994020 

02994040 

02994060 

02994080 

02994100 

02994120 

02994140 

02994160 

02994180 

02994200 

02994220 

02994240 

02994260 

02994280 

02994300 

02994320 

02994340 

02994360 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0032*3 
0033*0 
0033*0 
0033*0 
0033*1 
0033*3 
0034*2 
0036*0 
0037*0 
0038*0 
0038*2 
0040*2 
0043*0 
0045*2 
0048*2 
0052*0 
0055*1 
0057*3 
0061*0 
0063*0 

0065*2 
0065*2 
0066*2 
0067*3 
0070*0 
0070*1 
0073*1 
0076*3 
0077*3 
0079*0 
0079*1 
0079*1 
0079*1 
0079*1 
0079*1 
0079*1 
0079*1 
0079*1 
0080*0 
0080*0 
0083*1 
0083*3 
0086*1 
0087*3 
0090* 1 
0091*3 
0093*3 
0099*0 
0102*1 

0104*1 

0104*1 

oioa*2 
0105*0 
0105*0 
0105*1 

0105*3 
0107*0 



c 



• 






WH1 * nxtelm; 

INDX * INDX + X) 

WH2 ♦• NXTELM? 
END ELSE 
BEGIN 

WH1 «■ NXTELMj 

WH2 ♦ o; 
end; 

IF CINOX *INDX + 1) > SIZE THEN 
BEGIN 

ARRAYSTUFF «• o; 

atog * false; 
end; 

go to rtnlst; 
end; 

if ctgg then 
begin % imaginary part of complex 
WH1 * listadrcu; 
wh2 «• o; 
ctog <• false; 
go to rtnlst; 
end; 

getnmlst; 

if enolist then GO to rtnlst; 

IF ARRAYSTUFF * THEN 
BEGIN 

afog «• true; 

si ze*( indx* array stuff. c18u5])+arr ay stuff, si zef ; 

thdt«-not p(*chstadr«-meme(*[listadr]).c18u5n)»t0p); p(del> *> 

GO TO srt; 
end; 

IF NOT PC*LISTADR»TQP*XCH*DEL) THEN LI STADR*PC *LI STADR ) ; 
WH1 *■ LISTADRC03; 

WH2 *■ IF DLN THEN LISTADRCU ELSE Ot 
CTOG ♦ cmplx; 
RTNLSTJ 

END getlist; 
subroutine nmsz; 
begin; 

stream cp1«-cnamev]sp2*0); 

BEGIN 

si +pu si ♦ si + 2; ■■ 

6CIF SC = " " THEN JUMP OUT; 

SI «-Sl + II TALLY * TALLY + 1)J 

Pi *-tally; 
end; 

nfc i <• p; 
end nmsz; 
subroutine put; 
begin; 

stream cp1«-[namev];p2«.nfci,p3*buff)j 

BEGIN 

si «■ Pi; si *si + 2; ds *p2 chr; 

pi «• di; 
end; 

buff * p; 
end put; 



02994380 
02994400 
02994420 
02994440 
02994460 
02994480 
02994500 
02994520 
02994540 
02994560 
02994580 
02994600 
02994620 
02994640 
02994660 
02994680 
02994700 
02994720 
02994740 
02994760 
02994780 
02994800 
02994820 
02994840 
02994860 
02994880 
02994900 
02994910 
02994920 
02994970 
02994980 
02994985 
02995000 
02995020 
02995040 

02995060 
02995080 
02995100 
02995120 
02995140 
02995160 
02995180 
02995200 
02995220 
02995240 
02995260 
02995280 
02995300 
02995320 
02995340 
02995360 
02995380 
02995400 
02995420 
02995440 
02995460 
02995480 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0107»2 
011810 
0113*1 
0117*3 
0117*3 
0118*1 
0122*3 
0123*2 
0123*2 
0125*1 
0125*3 
0126*2 
0127*1 
0127*1 
0127*3 
0127*3 
0128*0 
0128*2 
0130J0 

0130*3 
0131*2 
0132*0 
0132*0 
0133*0 
0134*2 
0135*1 
0135*3 
0136*2 
0139*1 
0143*1 
0143*3 
0143*3 
0146*3 
0147*2 
0151*2 

0153*1 
0153*1 
0153*2 
0154*0 
0154*0 
0155*1 
0155*1 
0155*3 
0157*0 

0157*3 
0158*0 
0158*1 
0158*3 
0159*0 
0159*0 
0159*0 
0160*2 
0160*2 
0161*2 
0161*3 
0162*0 
0162*2 



t 






SUBROUTINE FUNNYZERO; 
BEGIN 

SKP «■ W - CD + 6 + SQN); 

STREAM(Pi«- BUFF»P2*SKP^P3*SQN#P4*(D + 4)); 

BEGIN 

DI + P\t DI «■ 01 + P2J 

P3CDS * LIT "-»•;■ JUMP OUT TO U> 
L! OS <■ 2 LIT »G,»; 

P4CDS «■ LIT » "j. 

PI *• DI; 

end; 

BUFF <- p; 

END funnyzfrq; 

SUBROUTINE FINDE/' 

BEGIN IF DTOG THEN 

DQUBLECTEN[0 3,0,WHl*WH2,x,*,WHl,WH2} 

ELSE WH1 * TEN[0] x HHU 
EXP «• CC04WHlt42*3*6]«WHl[l»2*l3 + 12)x.9039) +,5; 
W2 * Oi 
IF DTOG THEN 
IF EXP > THEN 00U8LECTEnCEXP3,TENC69 + EXP3,«-,W1,W2) 

ELSE D0UBLECl»0#TENCEXP]#TENt69-EXP]#/*«.*WX»W2) 
ELSE Wl <• IF EXP £ THEN TENtEXP] ELSE 1/TENC-EXPJJ 
IF HH1 ■> Wl THEN GO TO ERTN; 
IF WH1 = Wl THEN 

if wh2 > w2 then go to ertn,* 
exp <- Exp-i; 

ERTN! 

end finde; 
subroutine numcqnvert; 

BEGIN 

IF 01 > THEN 
BEGIN 

DOUBLE C WH 1 » WH2#TENC 16], TEN t 853 #/»♦, HI #W2); 
DH1 ♦ Wl DIV 1.01 

end; 

IF 02 > THEN 
BEGIN IF DTOG THEN 
BEGIN 

DOUBLE ( WH 1, WH2, DH1, 0,TENtl6], TEN C 85 3.x,-, 

TEN[ 8],TEN[77],/,«.,W1,W2); 
DH2 * Wl DIV i; 
END 

ELSE DH2 * NHl DIV TENC83; 

end; 

if dtog then 

BEGIN 

D0UBLECWHl,WH2,DHl,0,TENtl63,TENC85 3,x, 

DH2'0*TENC 83,TENC773,x, + j»-,«.,W1,W2)I 
DH3 <- HI DIV l; 

END 

ELSE DH3 <• WH1 DIV 1J 

EXP «- exp + i; 
END NUMCONVERT; 
SUBROUTINE SETO; 
BEGIN 

IF DLN AND DT > 23 THEN 



02995500 

02995520 

02995540 

02995560 

02995580 

02995600 

02995620 

02995640 

02995660 

02995680 

02995700 

02995720 

02995740 

02995760 

02995780 

02995800 

02995820 

02995840 

02995860 

02995880 

02995900 

02995920 

02995940 

02995960 

02995980 

02996000 

02996020 

02996040 

02996060 

02996080 

02996J00 

02996120 

02996140 

02996160 

02996180 

02996200 

02996220 

02996240 

02996260 

02996280 

02996300 

02996320 

02996340 

02996360 

02996380 

02996400 

02996420 

02996440 

02996460 

02996480 

02996500 

02996520 

02996540 

02996560 

02996580 

02996600 

02996620 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0162*3 

0163«0 

016380 

0165«1 

016782 

016782 

0X68*1 

017080 

017082 

017183 

017280 

017281 

017283 

01738Q 

017380 
0173?! 

017681 
017882 

0182*3 
018382 
018383 
018880 
019483 
019982 
020083 

020182 

02038J 

020482 
0204*2 
0204 8 3 
0205*0 
020580 
020583 
020681 

020911 
021082 

021082 
0211*1 

021280 
021282 
021581 
021783 
021980 
021980 
0222*2 
0222*2 
022283 
0223*1 
0225*3 
0229*1 
0230*2 
0230*2 
023281 

0233*2 
0233*3 
0234*0 
023480 



I 
I 

4 

< 
4 

i 
i 

i 
i 



# 



BEGIN 

ZER0S*DT-23J DT * 23; 01 «• 7) D2 * 03 * 8; 
END ELSE IF DT>12 AND NOT DLN THEN 
BEGIN 

ZER0S<-DT-12; DT <• 12; Dl«-o; 02 * 4J 03 ♦ 8; 
END ELSE IF DT>16 THEN 
BEGIN 

D1*DT-16; 02*03+8; 
END ELSE IF DT > 8 THEN 
BEGIN 

di<-o;d2<"DT-8; d3«-s; 

END ELSE 
BEGIN 

oi*02*0;d3«-dt; 

end; 






eno seto; 

subroutine rndoff; 
begin if dtog 

IF Tl 2 



THEN 
THEN 



F Tl i- THEN 

DOUBLE (WH1,WH?#» 5> TEN [T 1 ]> TEN [ T 1 + 69] , x, + ,«., WH 1, WH2 ) ELSE 
D0UBUE(HHl#WH2#*5»TENC-Tl3»TEN[69*TU»/'+***WHl»WH2) 
ELSE WHl * HH1 + C IF T1>0 THEN 5xTEN[Tl] ELSE 5/TENfTl])j 
ENO RNDOFF^ 
SUBROUTINE SeALEi 
BE6IN IF DTOG THEN 

BEGIN IF Tl J 

THEN D0UBLECWHl#WH2-,TEN[TlJ«TENCTl + 69)#x,«.,WHi#WH2) 
ELSE DOUBLE ( WHl * WH2» TEN [ -Tl 3 > TENC 69-T ll*/**-> WHl *WH2); 
IF WHl > TENCDT] THEN 
BEGIN 

EXP * EXP + I) 

D0U8LE(WH1#WH2#TENC1]*0*/**#WH1#WH2)1 
END 
END ELSE WHl ♦ IF Tl i THEN WHlxTfNCTU ELSE WH1/TENC -Tl 3 ; 

eno scale; 

%************** START OF EDIT-CONTRQL****************** 
SUBROUTINE CONVERT; 
BEGIN 

DTOG ! = false; 

SGN ♦WHl.Cllli; IF CODE 
DH1 <• DH2 + DH3 + ZEROS 
GO TO P(CODE#DUP»AOD); 

GO TO fmerr; 
go to fmerr; 
go to fmerr; 

GO TO E; 

go to oc; 

GO TO i; 

go to l; 

l« comment 

IF 



< LTYPE THEN 

+ EXP > SKP * 



WHl * ABS(WHl); WT + Wj OT 
SHFT * 01 + D2 + 03 + 0; 



♦ o; 



logicial conversion; 
w >i then skp<-w-(wt<-i); 



WHl* OSCIF WHl THEN »T" ELSE "F" ) C 12 t 42» 6 3 ; 
STREAMCPl J* BUFF8P2 ** WHl»P3 * = SKP# P4 J* WT)J 
BEGIN DI i* Pi; DI J* DI + P3; 

si :a loc P2; si i= si + 2; 
os i= P4 chr; pi »= di; 
end; 



02996640 
02996660 

02996680 
02996700 
02996720 
02996740 
02996760 
02996780 
02996800 
02996820 
02996840 
02996860 
02996880 
02996900 
02996920 
02996940 
02996960 
02996980 
02997000 
02997020 
02997040 
02997060 
02997080 
02997100 
02997120 
02997140 
02997160 
02997180 
02997200 
02997220 
02997240 
02997260 
02997280 
02997300 
02997320 
02997340 
02997360 
02997380 
02997400 
02997420 
02997440 
02997460 

02997480 
02997500 

02997520 
02997540 
02997560 
02997580 
02997600 
02997620 
02997640 
02997660 
02997680 
02997700 
02997720 
02997740 
02997760 



T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0236*1 
0236'3 

024013 
0243*2 
024410 

0248*1 
0249*2 
0250*0 
0252*2 
0253*3 
0254*1 
0257*0 
0257*0 
0257*2 
0259*2 
0259*2 
0259*3 
0260*0 
0260*1 
0261*2 
0266*1 
0271 JO 
0276*0 
0277*0 
0277*0 
0277*1 
027810 
0282*1 
0286*3 
0287*3 
0288*1 
0289*2 
0292*1 
0292*1 
0297*1 
0297*2 
0297*2 
0298*0 
0298*0 
0298*3 
0303*3 
309*0 
0310*0 
0310*2 
0311*0 
0311*2 
0312*0 

0312*2 
0313*0 
031312 
0313*2 
0316*2 
0319*3 
032112 

0322*1 
0322*3 
0323*2 



c 



# 



BUFF 
GO TO 
I» 



!s PJ 
COMM? 
COMMENT INTEGER CONVERSION; 

IF WH1«0 AND WH2sQ THEN OT * D3 <• 
BEGIN IF OTOG-. THEN 

DOUBLE C WH 1 » WH Z* # ,-5»*» *#.WHi» WH2) 5 

ELSE WHl «■ Tl ♦ WH1J 

finde; 

if exp < then dt «- d3 <- 1 else 

BEGIN 

IF CDLN AND EXP>24) OR (NOT DLN AND EXP*12) THEN 



i ELSE 

. ROUND OFF 



end; 
end; 



dt <- EXp+i; setd; numconvert; 



go ast; 



STREAM(P1«-0:P2 
BEGIN 



IF DT + SGN > W THEN GO To AST; 

IF W > DT + SGN THEN SKP «, H - DT 
«- Dl>P3 <- DH1*P4 «• D2>P5 * DH2* 
«■ D3*P7 «■ DH3*P8 «• SGN*P9 ♦■ SkP'PIO «■ 
DI ♦ PiO; P9(DI*'DI + 1)I 
P8CDS «■ LIT 

pa; ds <- P2 dec; 

* p<j dec; 

♦ P6 dec; 



- sgn; 
buff); 



SI 

si 

SI 

Pi 



<"LOC 

* LOC 

* LOC 

*• oi; 



P5; 
P7; 



DS ♦ 
DS 
DS 



< THEN GO TO AST; SETD; 



m 
m 



end; 
buff «• p; 
go to cqmm; 

DC! COMMENT DOUBlE PRECISION CONVErT#SAME AS E CONVERT; 

el comment e conversion? 

dtog *■ true; 

setd; 

if wh1 = and wh2 « then 

BEGIN 

IF W < (D+6+ SGN) THEN GO TO AST; 

FUNNYZERO; GO TO COMM; 
END ELSE 

BEGIN 

finde; 

if (skp ♦ w - d - 5 - sgn) 
if dt lss then dt := 0; 
ti * exp - dt; rndoff; 
setd; 

ti*dt-i-exp; scale; 
numconveRt; 
end; 
streamcpl *■ @sp2 «■ skp,p3 *• sgn#p4 *• 

p6 «■ D2.P7 *• DH2#P8 <• D3*P9 *■ 

Pll *■ (EXP < Q)*P12 * ABS(EXP)»Pi3 * 

BEGIN DI «■ P15; DI ♦ DI 

P2 * DO DS «■ LIT 

P5; OS «• 

P7; DS «■ 

P9; DS * 

lit " •• ); 

oi - i; os 



si 
si 
si 



*" 

«- 

*• 



LOC 

LOC 

LOC 
P14(DS *■ 
PlOCDI «• 
DS «• LIT 
piicdi «■ di - i; DS «• LIT "-»); 



+ 

". 
P4 
P6 
PS 
DS 
*■ 



?2i 

M « 



Dl,P5 ♦ 
DH3*P10 



P3(DS 



DH1* 

* (DLN)j. 
SHFT#P14 * ZER0S#P15 «-BUFF); 
* LIT "-'•); 



f 

dec; 
dec; 
dec; 

* LIT "E M 

LIT "D»); 



02997780 
02997800 
02997820 
02997840 
02997860 
02997880 
02997900 
02997920 
02997940 
02997960 
02997980 
02998000 
02998020 
02998040 
02998060 
02998080 
02998100 
02998120 
02998140 
02998160 
02998180 
02998200 
02998220 
02998240 
02998260 
02998280 
02998300 
02998320 
02998340 
02998360 
02998380 
02998400 
02998420 
0g998460 

02998480 
02998500 
02998520 
02998540 
02998560 
02998580 
02998600 
02998620 
02998640 
02998660 
0^998680 
02998700 
02998720 
02998740 
02998760 
02998780 
02998800 
02998820 
02998840 
02998860 
02998880 
02998900 
02998920 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0323*3 
0324*1 
0324J3 
03241-3 
0328*1 
32910 
0331 * 3 
0335* 1 
0336*0 
0338*2 
033910 
0344«2 
0348*0 
0348*0 
0348*0 
0349*3 
0353*1 
0355*0 
0356*2 
0357*3 
0359*0 
0359*3 
0360*2 
036111 
361*2 
036113 
0362*1 
0362*3 
0362*3 
0362J3 

0363*2 
0365*0 
0366*3 
0367*1 
0369*2 
0371*2 
037i*2 
037?tQ 
0373*0 
0377*0 
0379*0 
0381*0 
0382 10 
0385*0 
0386*0 
0386*0 
0387*3 
390*0 
039g»0 
0394*1 
0395*0 
0395*3 

0396*2 
0397*1 
0399*0 
0400*2 
0401*0 







€ 



SI * IOC P12J 

PI * DU 
P13C0I * P2; 
DS «- P13 



os «• 2 dec; 



Si <- 

chr; 



P2; 

DS 



SI «- SI 
LIT » " 



1; 

JUMP 



OUT TO X)/ X 



end; 

BUFF <• I 



go to cqmm; 



END, 



• 

m 



SETS PRNTR,C46»13»1. 






AST: 

STREAMCPl * 0JP2 * BUFF,P3 *• WJ ; 

BEGIN DI «■ P2; P3CDS <• LIT "*"); PI * DIJ 
BUFF *- p; 
COMM : 
END convert; 

COMMENT ********** END OF DECLARATIONS * * 
FIB * FJLXCNOT 21} % OPEN FILE IF NOT OPEN 

IF DKADR < THEN BEGIN FLG * U DKAOR *0 ENDJ 
IF FlBCS].C43»n THEN PCMKS,0,0, FILX» 1 * SELECT ) ; 
PRNTR«-2xCFIBC53 ,C4i:2]XO) ; %%% IFF FILE IS CLOSED* 
IF PRNTR THEN STREAMCTPAR } J DS«-3LIT" " ; 

ckpb; arraystuff <- o; 

IF FIBCO] = THEN FIBC03 :* 1 ELSE 

IF FIBCO] NEQ 1 THEN P CMKS, FIB 16 }, FILX , C 33 ; 15 3 , 4, FQRTERR ) ; 

LSTRN «■£>; CHR «• " "J NLI «■ FI* 

NAMEV «• CHR&"$"C18J42«63; 

NCR *NCR + CNFCI * 2)i PUT/ 

NAMEV <• FMTArNLI3«C12!363; 

NLE *■ FMTACNun,C2?10i; 

nmsz; put; ncr ♦ ncr + nfci; 

namev *• chr; ncr «• ncr + cnfci * 1); put; 

nmh getlist; if endlist then 
begin; 

STREAMCPt*-BUFF); 
8EGIN 

di «- pi; DI * DI - 3; DS * LIT "$*; 

end; 

donetog «• true; prnt; 
end; 

if prntr then prnt; 
code«-namev; namev«-chr; ncr*ncr+cnfc 1*2 ) ; put; namev«-cooe; 
nmsz; 

IF ELMTYP b INTEGV THEN 

BEGIN W *12; *0; CODE «- ITYpE END ELSE 
IF ELMTYP a LOGV THEN 

BEGIN W *U CODE «• LTYPE END ELSE 
IF ELMTYP s DBLV THEN 

BEGIN W *29; D <-23; CODE * DTyPE END ELSE 

BEGIN H *l8j * 12; CODE * ETYPE END; 
IF (6 + W + NFCI + C IF CMPLX THEN CW+3) ELSE 0) + NCR) 

> LCR THEN PRNT) 
PUT; % NAME 
NCR * NCR ♦ NFCI + 3t 

NAMEV «• CHR&" ■ " C 1 2 » 36 : 123 ; NFCI *3J PUT; 
NM2s IF ELMTYP « CMPLXV THEN 
BEGIN 

IF (NCR+W+W+6) > LCR THEN PRNT; 

NCR * NCR + CNFCI *-\)f NAMEV * CHR&"C "[ 1 2* 42 > 6 3 j PUT; 



02998940 
02998960 
02998980 
02999000 
02999020 
02999040 
02999060 
02999080 
02999100 
02999120 
02999140 
02999160 
02999180 
02999200 
02999220 
02999240 
02999260 
02999280 
02999290 
02999300 
02999320 
02999340 
02999420 
02999430 
02999440 
02999450 
02999460 
02999470 
02999480 
02999490 
02999500 
02999510 
02999520 
02999530 
02999540 
02999550 
02999560 
01999570 
02999580 
02999590 
02999600 
02999610 
02999620 
02999630 
02999640 
02999650 
02999660 
02999670 
02999680 
02999690 
02999700 
02999710 
02999720 
02999740 
02999750 
02999760 
02999770 



0402*2 
0403«0 
0403*1 
0404*2 
0406* 1 
0406*2 
0407*0 
0407*2 
0407*2 
0409*0 
041110 
04HI2 
04U %2 

04HI3 
0411 1 3 

0423*3 
0426*2 
0429*2 
043210 
0435*1 
0436*3 
0439*2 
0443*2 
0445* 3 
0447*2 
0450*0 
045i?2 
0453*0 
0456*1 
0460*0 
0460*0 
0462*0 
0462*2 
0463U 
0463*1 
0464*1 
0464*2 
0466*0 
0466*0 
0468*0 
0472*3 
0474*0 
0475*1 
0478*0 
0481H 
0483U 
0485*0 
048713 
0490*2 
0495*1 
0498*0 
0499*0 
0500*3 
0504*0 
0505*1 
0505*3 
0510*0 






m 
• 



m 
m 
m 
t 



© 



#< 



• 
• 



END 
BEGIN 



ncr * ncr + w; convert; 

ncr * ncr + cnkci«-1>; namev ♦ chr&"# "[ 12 142 8 6 ] ; put; 

ctos «• true; 

getlist; 

ncr .■«•■ ncr + w; convert; 

NCR *- NCR + (NFCI *4)J 

NAMEV <• CHR&"},"[12!36U23; PUT; 

ELSE 



if cncr + w + 3) 5 lcr then prnt; 
ncr «• ncr + w; convert; 

NCR «■ NCR + (NFCI * 3); 

NAMEV * CHR*w,»«Cl2i42l63; PUT; 

end; 

IF NOT ATQG THEN GO TO NM1J 

getlist; go to NM2; 

FMERR* 

PCMKS,FI8E63,FILX.C33tl5]#0#F0RTERR>J 

end foutname; 



• 



PROCEDURE DABS 



% 052 



COMMENT ABSOLUTE VALUE OF A DOUBLE PRECISION NUMBER; % PF 
BEGIN REAL X ■ -1» 
. XL * -2» 
JUNK = 17; 

p(x,ssp,.junk,std,xl*rtn); 
end dabs; 





02999780 


T 


0515*0 






02999790 


T 


0517>0 






02999800 


T 


0522*0 






02999810 


T 


052253 






02999820 


T 


0524*0 






02999830 


T 


0526*0 






02999840 


T 


0527*3 






02999850 


T 


0531*0 






02999860 


T 


0531*0 






02999870 


T 


0531*0 






02999880 


T 


0534*0 






02999890 


T 


0537*0 






02999900 


T 


053QJO 






02999910 


T 


0540*3 






02999920 


T 


0544*0 


« 




02999930 


T 


0544*0 




02999940 


T 


0544*3 






02999950 


T 


0546*2 


• 




02999960 


T 


0546*2 




02999970 


T 


0548*2 






SIZ 


E" 0549 WORDS 


« 






• 




03000000 


T 


0000*0 




START OF REL SEGMENT; DISK 


ADDRESS ■ 00461 


m 


JUNE 67 


03000100 


T 


0000*0 






03000200 


T 


0000*0 






03000300 


T 


0000*0 


• 




03000400 


T 


0000*0 






03000500 


T 


0000*0 






01000600 


T 


0001*2 


m 



SIZE- 0002 WORDS 



PROCEDURE CABS 



% 053 



COMMENT COMPLEX ABSOLUTE INTRINSIC; % PF JUNE 67 
BEGIN REAL X * "1* 

Y = -2, 

SQRT*+1 * 
P(INTOESCCSQRTI)) i 

IF (X <• ABS(X)} = OR (Y * ABS(Y)) « THEN P(X* Y, ADD* RTN ) 
ELSE IF X > Y THEN P CMK-S* 1* Y# X# /t DUP* MUf ADD* SQRT»X* MUL ) 

ELSE pcmks*i#x*y*/*dup#mul*add#sqrt»y#mul>; 

P(RTN)* 

end cabs; 



START OF REL 



03100000 

segment; DISK 

03100100 
03100200 
03100300 
03100400 
03100410 
03100500 
03100600 
03100700 
03100800 
03100900 



T 0000*0 
ADDRESS * 00462 



m 



0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0001*2 
0006*1 
0010*3 
0014*0 
0014*1 



SIZE- 0015 WORDS 



PROCEDURE AINT 



% 054 



0S200000 
START OF REL SEGMENT; DISK 



T 0000*0 
ADDRESS - 00463 



< 



BEGIN RFAL x = -i; 
P(X*l*DlV*RTN)j 
END AINTI 



03200100 T 0000*0 
03200200 T 0000*0 
03200300 T 000l*0 

size= oooz words 



PROCEDURE MATH; 

COMMENT MATHEMATIC 
CODE 



MA 



% 055 

NIPUUTION INTRINSIC % PF JUNE 67 
3*TYPECQP D + 9X0PERAT0R + TYPE(OP 2) 
TYPE VALUE OPERATOR VALUE 

REAL * 

DOUBLE l - 1 

COMPLEX 2 * 2 

/ 3; 



START OF REL 



BEGIN REAL CODE = 

A = 
B = 
C ■ 
D = 
ERR 
t; 

LABEL RPLUSD 
CLESSD 
RDIVDC 

go to pccode'dup'a 
go to inline; 
go to rplusd* 
go to rplusc; 
go to inline; 
go to inline; 
go to dplusc; 
go to inline; 
go to cplusd; 
go to cpluscj 
go to inline; 
go to rlessd; 
go to rlessc; 
go to inline* 
go to inline; 
go tg dlessc; 
go to inline? 
go to clessd; 

GO TO CLESSc; 

go to inline; 
go to rtimed; 
go to rtimec; 
go to inline; 
go to inline; 
go to dtimec; 
go to ctimer; 
go to ctimed; 
go to ctimec; 
go to inline; 
go to rdivdd; 



•1* 

'5* 

' 2 



If 



,RP L 
*CLE 
• DDI 

do); 

% 
% 



use, dplusg* cplusd, cplusc, rlessd* Rlessc* dlessc, 
ssc, rtimed* rtimec, dtimec, ctimed* ctimec* rdivdd, 
vdc*cdivdo*cdivdc,ctimer*cdivdr*inline; 



X 

% 



% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 
% 



REAL + REAL 

REAL + DOUBLE 1 

REAL + COMPLEX 2 

DOUBLE + REAL 3 

DOUBLE + DOUBLE 4 

DOUBLE + COMPLEX 5 

COMPLEX + REAL 6 

COMPLEX + DOUBLE 7 

COMPLEX + COMPLEX 8 

REAL - REAL 9 

REAL » DOUBLE 10 

REAL - COMPLEX 11 

DOUBLE - REAL 12 

DOUBLE - DOUBLE 13 

DOUBLE - COMPLEX 14 

COMPLEX <■ REAL 15 

COMPLEX - DOUBLE 16 

COMPLEX - COMPLEX 17 

REAL * REAL 18 

REAL * DOUBLE 19 

REAL * COMPLEX 20 

DOUBLE * REAL 21 

DOUBLE * DOUBLE 22 

DOUBLE x COMPLEX 23 

COMPLEX x REAL 24 

COMPLEX x DOUBLE 25 

COMPLEX x COMPLEX 26 

REAL / REAL 27 

REAL / DOUBLE 28 



03300000 

segment; disk 
03300100 

03300200 

03300300 

03300400 

03300500 

03300600 

03300700 

03300800 

03300900 

03301000 

03301100 

03301200 

03301250 

03301300 

03301400 

03301500 

03301600 

03301700 

03301800 

03301900 

03302000 

03302100 

03302200 

03302300 

03302400 

03302500 

03302600 

03302700 

03302800 

03302900 

03303000 

03303100 

03303200 

03303300 

03303400 

01303500 

03303600 

03303700 

03303800 

03303900 

03304000 

03304100 

03304200 

03304300 

03304400 

03304500 

03304600 



T 0000*0 

ADDRESS ■■ 00464 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

t ooom 

T 000l*3 

T 0002*1 

T 0002*3 

T 0003*1 

T 0003*3 

T 0004*1 

T 0004*3 

T 0005*1 

T 0005*3 

T 0006*1 

T 0006J3 

T 0007*1 

T 0007*3 

T 0008*1 

T 0008*3 

T 0009*1 

T 000913 

T 0010*1 

T 0010*3 

T OOilU 

T 0011*3 

T 0012*1 

T 0012*3 

T 0013*1 

T 0013*3 

T 0014*1 

T 0014*3 

T 0015*1 






m 
m 



GO TO RplVDC; % REAL / COMPLEX 29 
SO TO INLINE; % DOUBLE / REAL 30 
GO TO INLINE^ % DOUBLE / DOUBLE 31 
60 TO DDIVDC) * DOUBLE / COMPLEX 32 
GO TO CDIVDRJ % COMPLEX / REAL 33 
GO TO CDIVDO; % COMPLEX / DOUBLE 34 
GO TO CDIVDC; % COMPLEX / COMPLEX 35 
RPLUSDS PC0*C»8>A*DLA,.B,STD,.C»STD,XIT); 
RPLUSC? ■PCA#C#ADD»B»,C»STO#.B*STD*XIT)J 
DPLUSC: PCA»C>ADD».CSTD>B>.D»STD'XIT>; 
CPLUSDJ P(A»C,ADD> »C,STD,XIT); 

CPLUSC* PC A»C#ADD#.C»STD>B>D#ADD# ,D*STD*XIT); 
RLESSDt P(0»C»B*A*DLS,,B#STD*,C*STQ>XIT>J 
RLESSCS PCC>A,SUB>B>CHS, ,C,STD# .B»5TD»XlT); 

DLESSCs pcc*a,sub, ,c,$td,b#chs#.d»std>xit); 

clessd: pcc»a»sub»,c*std#xit)j 

clesscj p(0>b*sub» .0, std, c, a, sub, , q, sldf x it 5 ; 

rtimed: p(o>c»b*a*dlm*,b>std*.c*std*xit); 

Rtimecj p(c»dup»b#mul#.c#std#a,mul,.b»std»xit>; 

dtimecj p(c'dup*a*mul>,c>std>8'mul*,d*std>xit); 

ctimer* pca*dup»b»mul*.b*std^c»mul*.c#std*xit); 

CTIMEDJ PCAfDuP^C*MUL^,C*STD#D^MuL#.D»STD*XIT); 

ctimecs pca>c»mul»d*b>mul*sub*c»b*mul>a>d,mul>add,,d,std,,c*std#xit>; 

roivddj f(0#c#b>a#dld*,b*std* »c* std# xit >i 

rdivdc! f<c.*a>dup#mul*b>dup#mul*add#/#dup»b*muu-*chs* 

,C^5TD,A,MuL^,B#STDfXlT); 
DDIVDC! PCC>A,DUP,MUl>8>DUP>MUL>ADD*/*DUP,B*MUL>CHS, 

.D,STD,A,MUL*.C,STD>Xln; 
CD IVOR! PCB'A^/*.B»STD*C*A»/#.C'STD»XIT); 

CDIVDD! P(C>A>/> .c>std>o>a>/> .d>std»xit); 

CDIVOCJ P(A*C*MUL^8»D*MUL#ADD*A^DUP#MUL*B#DUP#MUL#ADD*,T*STN,/, 

A«D#MUL*B>C*MUL»SUB#T»/#.O^STD#.C#STO#XIT)l 

INLINEJ P(MKS*10*ERR3; % COMPILER WRITERS ERROR 

END MATHJ 



03304700 T 0015*3 



03304800 

03304900 

03305000 

03305100 

03305200 

03305300 

03305400 

03305500 

03305600 

03305700 

03305800 

03305900 

OS306000 

03306100 

03306200 

03306300 

03306400 

03306500 

03306600 

03306700 

03306800 

03306900 

03307000 

03307100 

03307200 

03307300 

03307400 

03307500 

03307600 

03307700 

03307800 

01307900 

O33O8OOO 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0016*1 
0016*3 
0017* 1 
001753 
0018* 1 
0018*3 
0019*1 

002i*3 
0024*0 
0026*1 
0027*3 
0030*2 
0033*0 
0035*2 
0038*0 
0039*2 
0042*1 
0044*3 
0047*2 
0050U 
0053*0 
0055*3 
0060*2 
0063*0 
0066*1 
0068*0 
0071*1 

0073*0 
0075*3 
0078*2 
0082*3 
0086*1 
0087*0 



€ 
i 






SIZES 0088 WORDS 



PROCEDURE XTOIJ 



% 056 



COMMENT VARIOUS COMBINATIONS OF X TO THE I 
CODE » 3xTYPEC0P 1) + TYPeCOP 



* PF JUNE 67 



START OF REL 



2) 



begin real 



TYPE VALUE 

REAL 

DOUBLE 1 

COMPLEX 2 s 
CODE = "1» 
A ■ "3 J> 
B = -4, 
C = -5* 
D = "6* 
JUNK » 17> 

T=+l»Vs+2»ERR»+3*B00L=+4»CDT0G=+5 ; 
REAL EXPINT»27> LNlNT=29 } 
INTEGER J=+6> i-J»R=C0T0G i 
REAL EXPs+7#LN»+8#0EXP»EXP»DL0GaLN#CABSs+9»ATAN2«+10#SQRT"+ll» 



03400000 

segment; DISK 

03400100 

03400200 

03400300 
03400400 
03400500 
03400600 
03400700 
03400800 
03400900 
03401000 
0S4OI 100 

03401200 
03401300 
03401350 
03401400 
03401500 



T 0000*0 
ADDRESS ■ 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000?0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



00467 










• 



PC0K85 
IF COD 
PCDFCE 
PICK! 
GO TO 



GO 
GO 
GO 
GO 
GO 
GO 
GO 
GO 

GO 



TO 
TO 
TO 
TO 
TO 
TC 
TO 
TC 
TC 



DEXPOC 
REXPOC 

13? 



CO 
DEFINE 
LABEL R 
L 
F 
[1141*7 
E<5 THE 
XPI )*DF 

T*0 
P(CODE# 
REXPOR* 
REXPODii 
REXPOC) 
DEXPORJ 
DEXPODi 
DEXPOC* 
CEXPOR! 

cexpoo; 
cexpoc; 

J R*P( 
I R*P( 

if e 

IF B 



5 = 
DF 
EX 
2, 
09 
]* 
N 

a 

♦ 

f 

DU 



L4J 

L5» 

Lit 



L2: 



CEXPOCS 



PI'S* 
MAX? 1 ! 
PIT! U 

REXPOR! 



REXPORl! 



• C 

,B 

SO 

B 

I 
I 
I 



+12*SIN=+13 ; 
(0F1)=FLA6(0FI OR T) # I 

PGR*DExPQR*REXPOQ>DExPOD*CEXPOD*CEXPQR*RExPQC*DEXPQC*Ll» 
L3*L4*CEXPGC*CDENT,RDENT, TOPI* TOP IL*PI2'TPI2*HAF*PI* MAX* 
6*L5*PIT*CREL*PICK*RX1*RX2*REXP0R1*C£XP0D2 '* 
0*DF(FORTERRn*0*0*0)* IF CODEsO THEN 60 REXPQR ; 
IF CODE/2 THEN BEGIN PC OF C DEXPI ) * DF( DLOGI ) )* GO PICK END) 
NI)*DFCCABSI)*DFCATAN2I)*DFCSQRTI)*DFCC0SI)*DFCSINI)) * 

P*ADD); 

% REAL ** REAL 

% REAL ** DOUBLE 1 

% REAL ** COMPLEX 2 

% DOUBLE ** REAL 3 

* DOUBLE ** DOUBLE 4 

% DOUBLE ** COMPLEX 5 

% COMPLEX ** REAL 6 

% COMPLEX ** DOUBLE 7 

% COMPLEX ** COMPLEX 8 
); I*P(,0); C«-C + 0&CtHl«8]&DC47i9lt3l 60 L3 ; 

)* i*pc,C) ; 

THEN BEGIN P C ) * GO LI END ; 

THEN 
EGIN 



F AsO THEN BEGIN 
F C>0 THEN GO L5 
F ABS(A) LEG PCM 
BEGIN A«-800L 
PCABSCC)*A*M 
IF B*0 THEN 
P(R*STD*0*I* 
END ; 

t^-pcphxa; pcmks 

END ; 

T«-CV<.PCMKS*A8SCC)*LN>> 

IF A = THEN 
BEGIN 

IF C>0 THEN PCMKS 
FCMKS*C»PCPI 5)xB* 
P(V«-P*MKS*T*COS»x 

END i 
IF C<0 THEN 

BEGIN PCMKS*VxA-B 

IF ABSCA) LEQ 1023 THE 

PCMKS*AxV*EXP)* GO L2 

IF B = THEN GO CEXP0D2 

R + PCC3* I*P(,D)J IF 

IF C»0 THEN BEGIN T«-AB 

ELSE BEGIN T*PCMKS*D*C 

T*CBOOL«-PCMKS*T*LN))xB 

3,1^159265359 ; 

$0007777777777777 i 

01141444176652104 ; 

IF B * OR B « 1 THEN 

IF A * THEN PC1*.B*ST 

IF A8SCAX4Q96 THEN I 

BEGIN IF BOOL«-J<0 THE 



pen; go Li end ; 

■ a 

f 

AX) THEN IF PCA*,B00L*ISN)sA THEN 

j 

KS*,EXP*LOD*INTCALLC*P(.LN)*XTOin*DEL) * 
GO L2J IF BOOL THEN PCCHS) * 
STD*XIT) ; 

*MKS*ABScC)*LN*A*x, E xP)** GO L2 * 

xB J 



*T*C0S*R,STD*MKS*T*SIN*I*ST0*XIT) ** 

exp) ; 
*r*sto*mks*t*sin*v*x*i*sto*xit3 * 



XPCPI)*EXP); T«-T + PCPI)xAJ GO L2 END i 

N IF PCA,«B00L#ISN)*A THEN GO L4 \ 



D*0 THEN GO L3 ; 
SCO)* PCplT)* IF D<0 THEN PCSSN)J V«-P END 
*CABS); V*PCMKS*D*C*ATAN2) END J 
*vxa; P(MKS*BQ0LXA-*VXB*EXP); GO L2 * 



P CXIT )i 

D'XIT); 

F CJ*A)=A THEN 

N J<-"J * 



03401510 
03401520 
03401600 
03401700 
03401710 
03401800 
03401900 
03401910 
03401920 
03402000 
01402100 
03402200 
03402300 
03402400 
03402500 
03402600 
03402700 
03402800 
03402810 
03402815 
03402820 
03402825 
03402830 
03402835 
03402837 
03402840 
03402845 
03402850 
03402855 
03402860 
03402865 
03402870 
03402875 
03402880 
03402885 
03402890 
03402895 
03402900 
03402905 
03402910 
03402915 
03402920 
03402925 
03402930 
03402950 
03402965 
03402970 
03402975 
03402980 
03402965 
03402990 
03402991 
03402992 
03403000 
03403100 
03403200 
03403300 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0004*2 
0009*2 
0016*2 
0017*1 
0018*1 
0018*3 
0019*1 
0019*3 
0020*1 
0020*3 
0021*1 
0021*3 
0022*1 
0022*3 
0028*0 
0029*2 
003i«2 
0032*1 
0032*3 
0034*3 
0036*0 
0038*3 
0040*0 
0043*3 
0046*0 
0047*2 
0047*2 
0051*1 
0051 '1 
0053*3 
0054*2 
0055*0 
0059*0 
0060*2 
0064*2 
0064*2 
0065*1 
0070*1 
0073*2 
0075*1 
0076*2 
0079*1 
0083*1 
0087*1 
0093* 1 
0095*0 
0096*0 
0097*0 
0099*2 
0101*3 
0104*2 



• 



PCJ,.T#STD*B); 

WHILE CT <- CJ * 

BEGIN P(DUP); 

IF J THEN 
BEGIN V ♦ V + 
PCDUP)^ 

end; 
p(mud; 



H, £36*113) X DO 






END/ 

WHILE 

IF 



DO PCMUL). 



>D) ELSE P(.B#,C) I 



(V «. v - 1 ) > 
BOOL THEN PCl'XCH*/); 
IF CDTOG^O THEN 
BEGIN 

IF CPT0G>2 THEN PC.C# 
J«-CJ*A) AND 3' 
IF BOOL AND J THEN J«-(J + 2) AND 3i 
IF C = THEN RXl-l P (0, XCH*STD* STD, X IT ) I 

if j * o then go rxi; 

IF jsl THEN BEGIN P(xCH); GO RXl END I 
IF J = 2 THEN RX2? P(0» XcH* STD* XCH* CHS* XcH* STD'XlT ) 
P(XCH); GO RX2 ; 
END / 
PC.B'STD'XIT); 



REXPOD* 
DEXPOR! 
DEXPOO* 
RDENTJ 



EnO; 
IF B>0 

THEN PCMKS,MKS,B,LNINT*A>x>ExPlNT> .B*STD*XIT)J 
P(MKSMl'ERR); 
P(0#.B>.C)J GO 



%FORTRAN ONLY 



go rdent ; 

IF C=0 THEN 



P(0*CODE»STD*XIT) 



RDENT ; 

pcc,.8,.c>; c*b; b*o; 

PCD*.C#.D) i 

code+p; r«-p; junk«-p; 

IF A = Q THEN PU*R*STd*0*CQDE*STD#XIT) 
IF B = THEN 

IF ABSCAXPCF096) THEN IF (J«-A) = A THEN 
BEGIN IF BOOL *• J < THEN J «• -J J 

P(j»,T*STD' junk*c) ; 

WHILE CT * CJ «■ T). [36*113? ^ OQ 
BEGIN PC,A*STD*DUP*A*XCH*A); 

IF J THEN 

BEGIN V * V + i; 

p(.a*std>oup»a*xch#a); 
end; 

pcdlm); 
end; 

WHILE (V f v - i) > o oo pcdlm); 
if bool then p ( .t* std*0» xch, 1, xch* t*dlo ) 
P(R*std#code'Std*xit) ; 



if e>o 



end; 

THEN 



CEXP0R: 
CDENT J 



P(MKS*MKS# JUNK, C*DL0G# JUNK, B* A* DLM,DEXP* CODE* STD^ 

junk,r,std»xit) ; 
pcmks,h,erR); 
if b =0 then if c = then pcxlt); 

IF A s THEN PC1#,B»STOfO#,C#STO*XIT)I 
IF ABSCAXPCF096) THEN IF CJ*A) = A THEN 
BEGIN 
IF C=0 OR 8=0 THEN 

BEGIN C[)TQG«-COTOG OR 2} If B*0 THEN B«-CJ GO REXP0R1 END ; 



03403400 


T 


010753 


03403500 


T 


0108*3 


03403600 


T 


011112 


03403700 


T 


0111*3 


03403800 


T 


0112*0 


03403900 


T 


0113*3 


03404000 


T 


0114*0 


03404100 


T 


0114*0 


03404200 


T 


0114*1 


03404300 


T 


0116*0 


03404400 


T 


0119*0 


03404410 


T 


0120*2 


03404415 


T 


0121*1 


03404420 


T 


0121*3 


03404422 


C 


0124*2 


03404424 


C 


0126*1 


03404425 


T 


0129*1 


03404430 


P 


0131*3 


03404435 


T 


0133*0 


03404440 


T 


0135*0 


03404445 


T 


0138*1 


03404450 


T 


0139*0 


03404500 


T 


0139*0 


03404600 


T 


0139*3 


03404700 


T 


0139*3 


03404710 


T 


0140*0 


03404800 


T 


0143*2 


01404900 


T 


0144*1 


03405000 


T 


0145*2 


03405100 


T 


0148*1 


03405200 


T 


0149*0 


03408100 


T 


0152*3 


03408200 


T 


0155*3 


03408300 


T 


0156*2 


03408400 


T 


0159*3 


03408500 


T 


0163*0 


03408600 


T 


0164*1 


03408700 


T 


0167*0 


03408800 


T 


0168*2 


03408900 


T 


0168*3 


03409000 


T 


0170*2 


03409100 


T 


0172*0 


03409200 


T 


0172*0 


03409300 


T 


0172*1 


03409400 


T 


0172*3 


03409500 


T 


0175*3 


01409600 


T 


0178*2 


03409700 


T 


0179*3 


03409800 


T 


0179*3 


03409900 


T 


0184*0 


03410000 


T 


0185*0 


03410100 


T 


0185*3 


03410200 


T 


0188*2 


03410300 


T 


0191*2 


03410305 


T 


0194*1 


03410310 


T 


0194*3 


03410315 


T 


0196*2 



i 



IF 






• 



CEXPOD? 
CEXPQD2 



TOPI 
HAF 
PIZ 
TPI2 



i i 



BOQUj<0 T 

go crel; 

PCJ>,T>STD 

WHILE (T ♦ 

BEGIN PC. A 

IF J 

BEGI 



HEN J*-J ; 

F096H* 4096; CREL* 

CJ *■ T),E36I111) * 00 
#STD#DUP#A»XCH>A>j 

THEN 
N V «■ V 4 1J 

PC,A*STD*OuP'A'XCH*A); 



end; 

pcdup*mul*xch*dup»mul*sub#, a»std#muu#0up#ao0*a)l 



end; 

WHILE CV «■ 

P( ,A>STD,.B#ST 

X 

IF BOOL TH 



I 

end; 
C *■ (v «• 
x(a «■ 
P(MKS#1»A 
IF T > PC 
PCV*MUL>. 
IF CDTQG 

pcxiT); 

A*A+0&AE1 
IF C=0 TH 
IF A*0 TH 

B «■ c; 
c «• d; 

CDTOG «- T 
GO TO CDE 
£11462207 
011540000 
P1H14441 
011445545 



F CDTOG T 
E 



V • 1) > 00 

D*,C*STD'DUP,A»MUL'B#C»MUL*ADD* 

CH,CHS,6,MUL, A, C* MUL* ADD ) ; 

EN PC.A*STD*CHS#DUP#DUP»MUL*A»DUP# 

MtiL>ADo, .b*stn>/*a*b>/); 

HEN PC.C'STD'.D'STD'XIT) 
LSE P< .B,STD,.C*STD*XlT); 



P(MKS#MKS 

PC^KS^MKS 

>DUP,MUL* 

PI2) THEN 

B,SfO); 

THEN FCC,.D,5TD,B,,C,STD>; 



»MKS,C,B,CA6S>LN>A#MuL>EXP)) 
#C*B^ATAN2*A,MUL*T0PI,M0D»»T»STN#SIN)); 

SUB^SQRT); 
IF T < PCTPJ2) THEN PCCHS)* 



US834BC47J9I13 I 

EN IF 0=0 THEN PCXIT) / 

EN PCI* .C*STD#0# ,D#STD'XIT) ; 



rue; 
nt; 

73250420; 

00000000; 

76652104; 
74376314; 



TOPIL *«* P000550604323046i; 



END XTOi; 



03410400 
03410450 

03410500 
03410600 
03410700 
03410800 
0S410900 
03411000 
03411100 
03411200 
03411300 
03411400 
03411500 
03411600 
03411700 
03411800 
03411900 
03412000 
03412100 
03412200 
03412300 
03412400 
03412500 
03412600 
03412700 
03412800 
03412900 
03413000 
03413050 
03413100 
03413200 
03413300 
03413400 
03413500 
03413600 
03413700 
03413800 
03413900 
03414000 



T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SIZE 



0200*3 
0203*2 

0205*0 
0206*1 
0209*0 
0210*2 
0210*3 
0212*2 
0214*0 
0214*0 
0217*0 
0217*2 
0219*3 
0223*0 
0225*2 
0228*1 
0230*1 
0232*1 
0234*0 
0234*0 
0236*2 
0241* 1 
0243:0 
0245*3 
0246*3 
0249*0 
0249*1 
0252*2 
0255*1 

0258*1 
0259*0 

0259*3 
0260*2 
026i*0 
0263*0 
0264*0 
0265*0 
0266*0 
0266*0 
* 0267 



WORDS 



PROCEDURE IDINT '> 



% 057 



COMMENT DOUBLE TO INTEGER CONVERT; 

BEGIN RfAL X = m \> 

XL s *2J 

PCX + 04XC1U*8J&XLE47I9»13*1#DIV,RTN)J 

END IDINT; 



% PF JULY 67 



03500000 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00476 



03501000 T 

03501001 T 

03501002 T 

03501004 T 

03501005 T 



OOOO'O 
0000*0 
0000*0 
0000*0 
0003*2 



SIZE* 0004 WORDS 



# 



PROCEDURE FLOAT J 



* 060 



03600000 T 0000*0 




* 



• 



• 

• 

• 



BEGIN REAL X = -l; 

P(X> RTN)/ 
END float; 



PROCEDURE SNGL I % 061 

COMMENT SNGL INTRINSIC (DOUBLE TO SINGLE CONVERT); 
BEGIN REAL X ~ -1* 
XL« m 2't 
PCX + 04XCl«l»8]&XLt47i9:i],RTN); 

END SNGLJ 



% PF JUNE 67 



START OF REL SEGMENT; DISK ADDRESS s 00477 

03600100 T 0000*0 
03600200 T 0000?0 
03600300 T 0000»2 

SIZE 3 0001 WORDS 



03700000 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 00478 



03700100 T 
03700200 T 
03700300 T 
03700400 T 

03700500 T 
03700600 T 



0000*0 
0000*0 
0000*0 

000010 

0003*0 
0003*0 



SIZE* OOCA WORDS 



PROCEDURE DBlE 



% 062 



COMMENT DBLE INTRINSIC (SINGLE TO DOUBLE)* 
BEGIN REAL X s -\, 

JUNK = W> 

p(X,,junk>sto#o>Rtn); 
end dble; 



% PF JUNE 67 









03800000 


T 


0000*0 




TART 


OF 


REL 


SEGMENT; DISK 


ADDRESS * 


00479 








03800100 


T 


0000*0 










03800200 


T 


oooo'o 










03800300 


T 


0000*0 










03800400 


T 


0000*0 










03800500 


T 


0001*1 





SIZE* 0002 WORDS 



PROCEDURE AMOD 



BEGIN 

END amod; 



REAL X = -2* Y = 
PCX MOO Y> Rtn); 



% 063 
-II 



START QF REL 



03900000 
SEGMENT* DISK 
03900100 
03900200 
03900300 



T 0000*0 
ADDRESS * 00480 
T 0000*0 
T 0000*0 
T 0001*0 
SIZE» 0002 WORDS 



* 

m 
m 



PROCEDURE TIME 



% 064 



COMMENT FORTRAN TIME INTRINSIC (LIKE ALGOL)* 
BEGIN REAL X =-H 
PCXMi.COMi.RTN); 
END TIME* 



% PF JULY 67 



04000000 T 0000*0 

START OF REL SEGMENT! DISK ADDRESS * 00481 

04001000 T 0000*0 

04001002 T 0000*0 

04001003 T 0000*0 

04001004 T 0001*0 

size* 0002 words 



PROCEDURE DMOD 



% DOUBLE PRECISION MOD INTRINSIC # ^065. 



04100000 T 0000*0 
START OF REL SEGMENT! DISK ADDRESS m 00482 






BEGIN 

REAL Hs + 2, B = M, BL*"2. A*-3, AL=-4, E*17; LABEL G.Q ; 

IF B = THEN IF BL = THEN PC MKS, INTC ALLC 1 3.F0RTERR I > ) ; 

IF PCAL,ABSCA),BL,NABSCB),OLA,DUP)=0 THEN GD Q ', 

If P<0 THEN P(AL,A,,E,*-,RTN) J 

IF CE«-PCAL,A,BL,B,DLD,0UP).[3;6:|}>13 THEN PC, E, ISO) ; 
PCXCH) ; 

IF E=0 DR H.C2SX3 THEN BEGIN PC DEL. 0* XCH.E ); * »PC , G.+.LOQ.LND. XCH )END 
ELSE BEGIN PC13-E); :: PC , G, +. LOD.LND) END ; 

IF PCDUP,ABSCH),0,1,DLA,BL»NABSCB),DLM,AL.ABSCA),DLA);>0 THEN 
Q« P(E*0,RTN) ; 

PCOEL,XCH,BL.B'DLM,CHS,AL.A,DLA,,E,*.RTN) ; 
61 Mf 3777777777777777, % OYNAMlC MASK CONSTANTS. 

? 3777777777777770 ^9 3777777777777700 *P 3777777777777000. P 3777777777770000 » 

? 3777777777700000,? 3777777777000000, ^ 3777777770000000, P 3777777700000000. 

? 3777777000000000, ^3777770000000000,^3777700000000000,^3777000000000000; 
END OF DMOD ; 



04100100 
04100200 

04100300 
04100400 
04100500 
04100550 
OA100600 
04100700 
04100750 
04100800 
04100850 
04100900 
04101000 
04101050 
04101100 
04101200 
04101300 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 

0000*0 

0000*0 

0004*2 

0007*2 

0009*3 

0013*3 

0014*0 

0019*1 

0022*0 

0026*0 

0027*2 

0030*2 

0032*0 

0036*0 

0040*0 

0044*0 



SIZE* 0045 WORDS 



i 
i 
I 

I 

i 
i 

i 
i 






PROCEDURE DMAX1 



X 066 



% PF JUNE 67 



COMMENT DOUBLE PRCISION MAX ROUTINE; 
BEGIN REAL X = -1. 

XL a "2. 

JUNK = 17* 

RCW = +0, SIZE = +1, NEW a +2. NEWL ■ +3, JUNKL « 
PC CRCWH INX 0, 0. RCW. FCX.l.INX, SUB, O.O.XL'X,. JUNK, STD)) 
WHILE (SIZE * SIZE - 2) > DO 

IF PCNEWL * *PC. X, SIZE, ADD,, NEW. STM.l, ADD). NEW <- *P(NEW), 
JUNKL, JUNK, DLS, XCH, DEL) > THEN 
BEGIN JuNKL <• NEWL; 

junk «. new; 
end; 
pc junkl, rtn); 
end dmaxi; 



START OF REL 



+ 4; 



04200000 


T 


0000*0 


segment; disk 


ADDRESS * 


04200100 


T 


0000*0 


04200200 


T 


0000*0 


0A20O30O 


T 


0000*0 


04200400 


T 


0000*0 


04200500 


T 


0000*0 


04200600 


T 


0000*0 


04200700 


T 


0003*3 


04200800 


T 


0006*0 


04200900 


T 


0009*2 


04201000 


T 


001111 


04201100 


T 


0012*2 


OA201200 


T 


001311 


04201300 


T 


0013*3 


04201400 


T 


0014*1 



00484 



size* 0015 words 



PROCEDURE DMINl 



% 067 



% PF 



JUNE 67 



= +2. NEWL * +3, JUNKL * +4; 



COMMENT DOUBLE PRCISION MIN ROUTINE. 
BEGIN REAL X » -1. 

XL * "2* 

JUNK a 17, 

rcw = +0, size = +i, New 

PCCRCW1 INX 0,0,RCW,FcX,l,INX,SUB,O.O.XL'X. i JUNK.STD); 

WHILE (SIZE* SIZE " 2) >0 DO 

IF PCNEWL * *PC. X, SIZE, ADO,, NEW, STN,1, ADD), NEW «■ *PCNEW), 

junkl, junk. dls, xch, del) < then 
begin junkl «• newl) 

junk ♦• new; 
end; 



START OF REL 



04300000 


T 


0000*0 


segment; disk 


ADDRESS ■ 


04300100 


T 


0000*0 


04300200 


T 


0000*0 


04300300 


T 


0000*0 


04300400 


T 


0000*0 


04300500 


T. 


0000*0 


04300600 


T 


0000*0 


04300700 


T 


0003*3 


04300800 


T 


0006*0 


04300900 


T 


0009*2 


04301000 


T 


oou»i 


04301100 


T 


0012*2 


04301200 


T 


001311 



00485 



# 
# 



• 



P( JUNKL#RTN)J 
END OMTNi; 



04301300 T 0013*3 
04301400 T OOUU 

SIZE" 0015 WORDS 



PROCEDURE SIGNV ; 



% 070 
% PF JUNE 67 



START OF REL 



COMMENT SIGN INTRINSIC* 
BEGIN REAL S * -1> 

IF S.C1U3 THEN P(SSN,RTN) ELSE P(SSP,RtN); 

end sign; 



04400000 

segment; disk 

04400100 
04400200 
04400300 
04400400 
04400500 
04400600 



T OOOO'O 
ADDRESS 9 



00486 



0000*0 
0000*0 
0000»0 
000010 

oooou 

0003*0 



• 
• 



SIZE* 0004 WORDS 



PROCEDURE QSIGN I 



% 071 



START OF REL 



COMMENT COMPLEX DOUBLE SIGN INTRINSIC; 
BEGIN REAL S c -1* 

X = "3* 

XL * "4* 

JUNK = 17; 
P C x ) ; 

IF S.ClilJ THEN PCSSN) ELSE PCSSP); 
P( ,JUNK,STO»XL»RTN) j 

end dsign; 



% PF JUNE 67 



04500000 

segment; disk 

04500100 
04500200 
04500300 
04500400 
04500500 
04500600 
04500700 
04500750 
04500800 



T 0000*0 

address * 



0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*1 

0002*2 

0003*2 



00487 



SIZE* 0004 WORDS 






PROCEDURE DIIM ; 



X 072 



START OF REL 



begin real x * "2> y - -u 

pcx -(if x s y then x else y)»rtn); 
end diim; 



04600000 

segment; disk 

04600100 
04600200 
04600300 



T 0000*0 
ADDRESS * 00488 
T 0000*0 
T 0000*0 
T 0003*0 
SlZEs 0004 WORDS 



PROCEDURE REALP ; 



% 073 



COMMENT COMPLEX TO REAL INTRINSIC; 

BEGIN REAL X s -1; 

P(X#RTN); 

end realp; 



% PF JUNE 67 



START OF REL 



04700000 
SEGMENT) DISK 
04700100 
04700200 
04700300 
04700400 



T 0000*0 
ADDRESS * 00489 
T 0000*0 
T 0000*0 
T 0000*0 
T 0000*2 
SIZE? 0001 WORDS 



PROCEDURE AIMAG ; 



% 074 



04S00000 T 0000*0 



c 



COMMENT IMAGINARY PART 
BEGIN REAL Y ■ »2', 
P(Y#RTN); 

end aimag; 



QF COMPLEX NUMBER; 



% PF JULY 67 



START QF REL 



segment; disk 

04801000 
04801010 
04801020 
04801030 



€ 



ADDRESS ■ « 00490 
T 0000*0 
T 0000*0 
T 0000*0 
T 0000*2 
SIZE* OOOl WORDS 



• 

• 
• 



PROCEDURE CMPI.X J 



% 075 



START OF REL 



comment two reals to a complex; 
begin real y = -i, 

X a -2* 

JUNK = 17; 

P(X» , JUNK»STD'Y>RTN); 

end cmplx; 



PF JULY 67 



04900000 

segment; disk 

04900100 
04900200 
04900250 

04900300 
04900400 
04900500 



T 0000*0 
ADDRESS * 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0001*1 



00491 



size* 0002 words 



PROCEDURE CONJG > 



• 
• 



COMMENT CONJUGATE INTRINSIC; 
BEGIN REAL X s -1* 

XL * "2* 

JUNK = 17; 
PCX*,JUNK,STD>XL'CHS*RTN); 

END conjg; 



% 076 

% PF JUNE 67 



START OF REL 



05000000 

segment; disk 

05000100 

05000200 

05000300 
05000400 
05000500 



T 0000*0 
ADDRESS * 



00492 



0000*0 
0000*0 
0000*0 
0000*0 

0000*0 



05000600 T 0001*2 



SIZE" 0002 WORDS 



PROCEDURE OEXP J X 077 

START OF REL 
COMMENT DOUBLE PRECISION EXPONENTIAL INTRINSIC; % PF JUNE 67 
BEGIN REAL X = -1* 

XL ■ -2* 

JUNK = n* 

t*tl; 
boolean sig*huge; 

Integer n; 

label atl3»lg2>lg2l>emax>haf»a>al,b>el>c>cl>d*dl*£>el'f,fl#g>gl» 

clgl,h,hl* i*il#j*jl>k,kl*l*ll#m*ml; 
define times * n0p*0la>xl* x, nop*dlm#; 

IF SIG «■ X.tl*l] THEN X * ABS(X); 

IF HUGF>X>27 THEN IF X>P(EMAX) TH£N PC MkS, I NTC ALL( 14* FORTERRI > > ; 

P(XL*X»LQ2L»UQ2*OUO».X*STD*D0P*X»XCH#X^O'AT13*OUAjiO»ATi3#OUS# 

.JUNK,STN J .DLS,.X,5TD*„XL>STD); 
T «■ l; IF HUGE THEN WHILE (N «■ N + 1) S JUNK DO P C TL» DUP# T* XCH* T, DL A, 

t T*STD»,TL>STD) 
ELSE WHILE CN «■ N ♦ 1) < JUNK DO T ♦ P < T* DUP, ADD ) ; 
P(Ml,M,xL#X»DLM); 



05 
SEGMENT 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 
05 



100000 
; DISK 
100100 
100200 
100300 
100400 
100500 
100600 
100700 
100800 
100900 
101000 
101100 

101130 
101250 
101300 
101400 
101500 
101501 
101502 
101600 



T 0000*0 
ADDRESS 



T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
000fl*0 
0009*0 
0009*0 
0013*1 
0015*0 
0020*1 
0021*1 
0026*1 



00493 






• 



t J P( 

IF SI 

PCRTN 

AT13 

HAF 

EMAX 

I.G2 

M 

L 

K 

J 

I 

H 

G 

F 

E 

C 
B 
A 
END D 



It i 
it : 

t: i 

i 1 1 

i i : 



LL.L. 
FL.F. 

CLGL. 
G THE 

); 

















(S 



t « ? 
t J : P 

exp; 



TIMES. KL.K.T,IMES,JL. 
TIMES, EL. E. TIMES. DL. 
LG2.TIMES.@,1.DLA.TL 
N P(0»XCH#1,XCH,JUNK 

0151000000000000; 
1154000000000000; 
1122360000000000; 
1155427102775750J 
133330233035177.3; 

1325447251503330; 
1301616647307714; 

1273641733265077; 

1267446477210572.5 
1.241552224137002; 

12326l300i073l74; 
122377/137704414 

1215030221137052; 
1205354l777i705i; 
ll7473125333735i; 
11634326043270U; 
) 151727757377602; 



J.TIMES.IL.I.TIMES.ML.H.TIMES.GL.G.TIMES. 
D.TIMES.CL.C.TIMES.BL.B.TJMES.AL.A.TIMES. 
.T.DLM. ,JUNK#STD); 
.DLD..JUNK.STD); 



CLGL 


$! 3 


LG2L 


J i i 


ML 




LL 




KL 




JL 


: s : 


IL 


• f • 

" * • 


HL 


i i t 


GL 


• • « 

• • • 


FL 


• * « 

• * * 


EL 


• • . 

• • 5 


DL 


ft* 

• * • 


CL 


i i : 


BL 


s s ? 


AL 


t i : 



§00071 
000071 

000054 

000037 
900026 
000066 
000034 
000072 
000020 
000004 
000057 
000022 
P00016 
000020 
000061 



73632567030; 
7363257U65; 
05676153645; 
45760641244; 
76025700645; 
64462403121; 

54166117342; 
63626741044; 
6l6i033465i; 
07415212622J 
57400272176; 
37577766326; 

57523134265; 
27630376772J 

30725275347; 



05101700 
05101800 
05101900 
05102000 
05102100 
05102200 
05102300 
05102400 
05102500 
05102600 
05102700 
05102800 
05102900 
05103000 
05103100 
05103200 
05103300 
05103400 
05103500 
05103600 
05103700 
05103800 
05103900 



0027!2 
0040»0 
0052*0 
0056?0 
0058*3 
0059*0 
0060*0 
006110 
0063*0 
0065i0 
0067*0 
0069*0 
007i*0 
007310 
0075*0 
0077«0 
0079t0 
008i»0 
0083i0 
0085*0 
008710 
0089*0 
009l«0 



PROCEDURE CEXP . % 100 

START 
COMMENT COMPLEX EXPONENTIAL INTRINSIC; % PF JUNE 67 
BEGIN REAL X = -1. 

Y s -2. 

junk = 17 ; 
label emax. topi. pi2.tpi2; 
if abs(x)>p(emax) then pc mks. intcallc 15, forterrl ) ) ; 
p(mks,rntcallcx.expd.,x.stn.mks.l.mks.y.topl.mod.dup'ssp.,y.std. 

callint(sini).dup.x,mul.,junk,std.dup.mul*sub.callintcsqrti).mul) 
if y > pcpi2) then if y < pctpi2) then p(chs); 
pcjunk.xch. .junk.std.rtn); 

EMAX it! 013.22360000000000; 
TOPI tii 01146220773250421; 
PI2 '*i 01141444176652104; 
TPI2 til 01144554574376314; 
END CEXP; 



SIZE* 0092 WORDS 



05200000 T 0000*0 

OF REL SEGMENT; DISK ADDRESS * 00497 

05200100 T 0000*0 

05200200 T 0000*0 

05200300 T 000050 

05200400 T 0000*0 

01200800 T 000010 

05200900 T 0000»0 

05201000 T 0003«2 

; 05201100 T 000812 

05201200 T 0014*1 

05201300 T 0017*0 

05201400 T 0018*1 

05201500 T 0020*0 

05201600 T 002H0 

05201700 T 002210 

05201800 T 0023*0 



SIZE* 0024 WORDS 



PROCEDURE DLOG 



% 101 



COMMENT DOUBLE PRECISION NATURAL LOG INTRINSIC; 
BEGIN REAL X « -1. 

XL b "2* 

JUNK ■ 17* 

t.Tl; 



% PF JUNE 



05300000 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS ■ 00498 

67 01300100 T 0000*0 

05300200 T 0000*0 

O53OO3OO T 0000*0 

05300400 T 0000*0 

05300500 T 0000*0 



c 



• 






integer n* 
boolean less!/ 

label haf,lg2,lg2l>s 

H*HL#I»Il.*'J#JL 

OEFINE TIMES * NQP#DLA*XL» 
IF X LEG THEN P(MKS,INTC 
IF LESSl * X < 1 THEN P(0, 
P(l# ,N*STN» .JUNK»STD35 
WHILE (JUNK «■ P(JUNK#DUP»A 
IF P(XL,X,0, JUNK, DLD». JUNK 
THEN 

BEGIN N ■* M - II 

PCHAF».TL*STO); 

END ELSE TL ♦ U 

P(T#JUNK#0#TL*bLS*T#JUNK#0 

JUNK,DLM#,X»STD* ,XL#STN, 

** PUL»I*TIMES*HL>H>T1MES 

DL,D, TIMES, CL>C*TIMES 

0,2,DLA,T,JUNK,0LM,Q,N 

IF LESSl THEN P(JUNK»CHS* f 

PCRTN); 



Q2»SQ2L,A,AL*8*BL>C>CL,D,DL>E,EL>F,FL>G,GL» 

* 
t 

X*NOP*DLM#; 

ALL(16+CXX0)»F0RTERRI)) I 

l*XL*X#DLO*,X,STD*,XL»STD>; 

do)) < x do n *■ n + i; 

»ST0*.T»STN#JuNK#SO2L#SQ2»DLSfXCH#DEU) < 



> TL> DL A. OLD* , JUNK, STD* ,T, STN, DUP> JUNK ,XCH, 

X,JL*J'DLM)j 

, GL> G, TlMES,FL>F, TIMES, EL* E* TIMES* 

,BL,B,TlMES,AL'A, TIMES, 

,LG2L,LG2,DLM,DLA,«JUNK,STD); 

JUNK,STO)l 



HAF 

LG2 

SQ2 

J 

I 

H 

G 

F 

E 

D 

C 

B 

A 

END 



: » : 
: : j 
: : : 
s : : 

: t j 
; : 



: t : 

J J \ 

DLOGl 



01154000000000000 
#1155427102775750 
P1155520236314774 
01167100510467432 
^1166521204435224 
01167420605757260 
01151042101275720 
0H5H665 16643351 
01151350564271710 
01151616161616162 

01152222222222222 
§1153146314631463 

01155252525252525 



LG2L 

SQ2L 

JL 

IL 

HL 

GL 

FL 

EL 

CL 

CL 

BL 

AL 



: : 

: : 

**; 

n i 
J i : 
** x 
i : : 
: : : 
t : : 

J! 5 

HI 



000071736325711651 
000073631102131361 
000021644604740161 
000076510244670031 
00002135500773125; 
000001026765655441 

0OOOH61621531O1U 
000070716355103001 
000066431723110511 

000021766330220261 
000014631767262431 

000025252525070531 



05300600 
05300700 
05300800 
05300900 
05301000 
05301100 
05301200 
05301300 
05301400 
05301500 
05301550 
05301600 
05301700 
05301800 
05301900 
05301950 
05302000 
05302100 
05302200 
05302300 
05302400 
05302500 
05302600 
05302700 
05302800 
05302900 
05303000 
05303100 
05303200 
05303300 
05303400 
05303500 
01303600 
05303700 
05303800 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
IZE 



0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0005*1 
0009*1 
0010*2 
0014*2 
0018*1 
0018*3 
0020*2 
0021*1 
0022*2 
0027*0 
0029*2 
0040*0 
0048*0 
0051*2 
0053*1 
0053*2 
0055*0 
0057*0 
0059*0 
0061*0 
0063*0 
0065*0 
0067*0 
0069*0 
007i*0 
0073*0 
0075*0 
0077*0 
0079*0 
0080 



WORDS 



• 
• 
# 

• 



PROCEDURE CLOG 



% 102 



COMMENT COMPLEX LOG INTRINSIC! % PF JUNE 67 
BEGIN REAL X s -1/ 
Y * -2, 
JUNK m 17 i 
IF Y=0 THEN 

IF XsO THFN PCMKS#I.NTCALL<18,F0RTERRI>> 

ELSE IF X>0 THEN PC MKS, I NTCALLC X ,LNl ) > . JUNK,STD>0*RTN ) 
JUNK*PCMKS,INTCALLCP(MKS,X,INTCALL(Y,CARSI)),LNI)) * 
P(MKS,Y,INTCALLCX,ATAN2I),RTN) i 
END CLOG* 



START OF REL 



0S4O0O00 
SEGMENT! DISK 
05400100 
05400200 
05400300 
05400400 
05400900 
05400950 
05400975 
05401000 
05401100 
05401200 



T 0000*0 
ADDRESS » 



0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*3 
0004*2 
0009*1 
0013*3 
0016*1 



00501 



SIZE* 0017 WORDS 



PROCEDURE AL.OGIO; 



% 103 



05500000 T 0000*0 






« * 



• 



COMMENT LOG BASE 10 INTRINSIC* % PF JUNE 67 
BEGIN REAL X*-l ; 

LABEL LGi; 
IF X LEQ THEN f? C MKS, JNTC ALL C 19+ ( X*G ) * fORTERR I ) ) 
P(MKS*INTCALLCX*LNI)*LGI*MUL*RTN) I 
LGI Mi 011533626754251161 
END AL0G1O) 



START OF REL SEGMENT; DISK ADDRESS * 00502 



05500100 
05500200 

05500400 
05500500 
05500600 
05500700 
05500800 



T 
T 
T 
T 
T 
T 
T 
SIZE* 



0000$0 
0000*0 

0000*0 
0000*0 
0004*1 
0007*0 
0008*0 
0009 



WORDS 



PROCEDURE DLOGlOi 



% 104 



% PF JUNE 



COMMENT DOUBLE PRECISION COMMON LOG INTRINSIC; 
BEGIN REAL X * -1* 

XL = "2' 
JUNK b 17 ; 

LABEL LGIjLGIL* 
IF X LEQ THEN P C MKS, INTC ALL C 2l*( X*0 )*F0RTERRI) ) i 
P(MKS*tL*INTCALLCX*DLOGI)*JUNK*LGlL*LGI*DLM*,JUNK*STD*RTN) ; 
LGI »*: 6»ll53362675425ll5j LGIL *** 0000624161452326 \l 
END 0L0G10J 



START 
67 



OF REL 



05600000 

segment; DISK 

05600100 
05600200 
05600300 
05600400 
05600600 
05600700 
05600800 
05600900 
05601000 



T 0000*0 
ADDRESS s 00503 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0004*1 
0008*1 

oon*o 



i 

i 

i 

i 
i 



size* 0012 words 



PROCEDURE DSIN ; % J05 

START OF REL 
COMMENT DOUBLE PRECISION SINE INTRINSIC; % PF JUNE 67 
BEGIN REAL X « -I* 

XL ■ -2» 

JUNK * 17* 

t; 
boolean sig; 

LABEL T0PI#T0PIL,PI#PIL,PI2,PI2L#TPI2#TPI2L# 

A*AL*8*8L*C*CL*D*DL*E*EL*F*FL*G*GL*H*HL*I*IL*J*JL* 
DEFINE ADDER « NOP* DLA* T* JUNK* NOP* DLM#* 

SUBER E NOP*DLS*T*JUNK*NQP*DLM#; 

IF SIG «• x.tnn THEN X <- PCX*SSP); 

IF P(MKS*XL»X,T0PlL*lNTCALL(T0PI*DM0DI),JUNK*,X*STD»tXL*STN*X#Pl2L*Pl2* 
DLS>XCH*DEL)>0 

THEN IF PCXL*X*PIL*Pl*DLS*XCH*DEL) < 
THEN PCPIL*PI*XL*X*DLS) 
ELSE BEGIN SIG * NOT SIGJ 

IF P(XL*X*TPI2L*TPI2*DLS*XCH*DEL) S 
THEN PCXL*X*PlL*Pl*DLS) 
ELSE PCT0PIL*T0PI#XL*X*DLS); 
END 
ELSE P(XL*X); 
PC,X*STD* .XL>STN*DUP*X*XCH*X*DLM* »JUNK,sTD* ,T* STN* JUNK* JL* J* DLM ) ; 
* « PC IL* I * SUBER* HL*H* ADDER* GL*G*SUBER*FL'F* ADDER* EL* E* SUBER* DL*D* ADDER* 

CL* C* SUBER* 8L* B * ADDER* AL * A* SUBER *0»1*DL A' XL* X* DLM* ,JUNK*ST0); 
IF SIG THEN PC JUNK*CHS* .JUNK*STD); 
PCRTN); 



05700000 

segment; DISK 

05700100 
05700200 
05700300 
05700400 
05700600 
05700700 
05700800 
05700900 
05701000 
05701050 
05701100 
05701200 
05701250 
05701300 
05701400 

05701500 
05701600 

05701700 
05701800 
05701900 
01702000 
05702100 
05702200 
05702300 
05702400 
05702500 



T 0000*0 
ADDRESS a 



00504 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0003*1 
0008*0 
0008*3 
0011*2 

0013*3 
0015*1 

0017*0 
0019*1 
0021*0 
0021*0 
0022*0 
0026*1 
0039*0 
0047*0 
0048*3 



• 
• 







« 

• 



PI2 

PI 

TPI2 

TOPI 

J 

I 

G 

F 

D 
C 
B 
A 
H 
END 



< i : 
5 : : 

: $ : 

S!8 

i i i 
a s 
; i : 
i s : 
J J j 



: ? : 

S I N . 



91141 

^ha3 

91421 
91371 
91323 
Pi 27l 

91253 
91235 
91216 
91174 
91151 
91356 



44«l76652 

110375524 
554574376 
220773250 
317506616 
136261610 
271771732 
3022214U 
271442547 
616743512 
400640064 
210421042 
252525252 
251301236 



I04j 

210; 

314; 

420; 

0431 

121 ; 
327; 

627; 
752; 

533; 
006; 
104; 

525; 
324;; 



P12L 

PIL 

TPI2L 

TOPIL 

JL 

11 

GL 

FL 

EL 
DL 
CL 

BU 
AL 

HL 



**l 
Si J 

HI 

; t : 

! i J 
!* J 

; t j 
? f : 

J : 
:: 



i j 



9000132141 
9000264302 

9000416443 
9000550604 
9000410634 
9000156140 
9000112236 
9000210130 

9000234733 
9000070470 
9000400635 
9000210421 
9000252525 
9000734437 



0646113; 

1514230; 

2362343; 
3230461; 
1505647; 
6721354; 
1440352; 
5056316; 

3135765; 
3144000; 

4436671; 
0366543; 
2525234; 
6112457; 



comment complex 
begin Real 



05702600 
05702700 
05702800 
05702900 
05703000 
05703100 
05703200 
05703300 
05703400 
05703500 
05703600 
05703700 
05703800 
05703900 
05704000 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

size 



0049*0 
005i JO 

0053*0 

0055*0 
0057*0 
0059*0 
006H0 
0063*0 
0065*0 
0067*0 
0069*0 
007t*0 
0073«0 
0075*0 
007710 
* 0078 



WORDS 



c 

1 

i 
i 
i 
i 



PROCEDURE CSIN ; % 106 

START OF 
SINE INTRINSIC; X PF JUNE 67 

X a -1, 
Y = '?.» 

JUNK = 17* 

t; 
label emax*haf,t0pi,pi2»tpl2; 
if a8scy)>pcemax) then p ( mks, ink allc 23,f0rterr i ) ) j 
p(mks,intcall(y,expi)*0up*dup#1«xciw# ,y* stn* sub»haf«'muu» ,t#std# 
y,a00,haf»mul*mks*x,tqpl#m0d*dup#ssp#.x#std#callintcs.ini>*jy#5tn#mul# 
mks#1,y,dup»mul#sub*callintcsqrti)#t>mul) i 
if x > pcpi2) then if x < pctpi2) then pcchs); 
pcxch>.junk,std>rtn); 



: 



EMAX 

HAF 

TOPI 

PI2 

TPI2 

END csine; 



5 : 



j : 



91122360000000000; 
9H54000000000000; 
9U46220773250421; 
9U4U44176652104; 
91144554574376314; 



05800000 

rel segment; disk 

05800100 
05800200 
05800300 
05800400 
05800800 
05800900 
05801000 
05801100 
05801200 
05801300 
05801400 
05801500 
05801600 
01801700 
05801800 
05801900 
05802000 
05802100 



T 0000*0 
ADDRESS * 00507 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0003*3 
0008*3 
001411 
0018*0 
0020*3 
0021*3 
0023*0 
0024*0 
0025*0 
0026*0 
0027*0 



ft 
t 



SIZE= 0028 WORDS 



PROCEDURE OCOS 



% 107 



COMMENT DOUBLE PRECISION COSINE INTRINSIC; % PF JUNE 67 

begin real x = -i» 

XL » "2* 

LOW s -4 > 

label pi2*pi2l; 
P<MKS,XL*x;PI2L>PI2>DLA'CALLINT<DSINI),RTN) ; 
PI2 :** 9114U44176652104; PI2L **» 9000l32l4l0646 \\ 3; 

END DCOS; 



START OF REL 



T 0000*0 
ADDRESS ■ 00508 



05900000 

segment; DISK 

05900100 T 0000*0 

05900200 T 0000*0 

05900300 T 0000*0 

05900400 T 0000*0 

05900600 T 0000*0 

05900700 T 0000*0 

05900800 T 0003*2 

05900900 T 0006*0 
SIZE* 0007 



WORDS 



e 



# 



% no 

INTRINSIC* 



% PF JUN 67 



START OF REL 



PROCEDURE CCOS ; 

COMMENT COMPLEX COSINE 
BEGIN REAL X = -1* 

JUNK a 17* 
TI 

LABEL EMAX,HAF,T0PI»TPI2*PI2,MHAF; 
IF ABSCY)>P(EMAX) THEN P C MKS* INTC ALL C 24, FORTERR I ) ) i 

PCMKS*InTCALLCY,EXPI),DUP*OUP*1*Xch*/*,Y*STN*SUB*MHAF*MUL*MKS*X*TOPI* 
MOD* DuP*SSP*.X*STD» CALL INTC SIN I )*,T*5tN* MUL*. JUNK, STO,Y, ADD, HAF,MyL* 
MKSM»T*OUP*MUL*SUB,CALLINTCSQRTI)*MUL5 i 
IF X > PCPI2) THEN IF X < PCTPI2) THEN P(CHS); 
P(JUNK»xCH» ,JUNK,STO>RTN); 



EMAX 

HAF 

TQPI 

TPI2 

PI2 
MHAF 

END 



: 
s J i 

ccOs 



01122360000000000; 

01154000000000000* 
^1146620773250421; 
01144554574376314; 
01141444176652104; 
03154000000000000; 



06000000 

segment; disk 

06000100 
06000200 
06000300 
06000400 

06000800 
06000900 

06001000 
06001100 
06001200 
06001300 
06001400 
06001500 
06001600 
06001700 
06001800 
06Q01900 
06002000 
06002100 
06002200 



T 0000*0 

ADDRESS 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0003*3 
0009*0 
0014*1 
0017*3 
0020*2 
0021*3 
0023*0 
0024*0 
0025*0 
0026*0 
0027*0 
0028*0 



00509 



SIZES 0029 WORDS 



PROCEDURE TANF i 

comment tangent intrinsic; 
begin real rsq; 

real x ■* -1; 

INTEGER Ql 
LABEL L1*L2 

s «• x,n*n TH 

CQ * PCX*PI,MQ 
0*1 THEN PCPI2 
X * THEN BEG 



% 111 



% PF MAY 67 



START OF REL 



boolea 

!,PMAx» 
IEN X ♦• 
!D*.X»S 
!*X*SU8 

-in if 

ELS 

end; 

PC1*X*0U.P' M UL> ,RSQ*STn. 



IF 
IF 
IF 

IF 



n s; 

MM AX *Pl* PI 2* PI 4. J 

P(X*SSP)* 
TN*PI4*0lV)) i THEN X «• 

) ELSE IF 0*2 THEN PCX*PI2*SUB) ELSE PCPI*X*SUB); 
* 1 THEN PCPMAXJ ELSE IF * 2 THEN P(MMAX) 
E PCO); GO TO Ll* 



IF Q 



/,A 

THEN PCX 
ELSE IF 



48,7 
.000 

do); 

,XCH,/ 
Q s 1 



DUP,, 0097 4 33825958, MUL* CHS* 1, ADO* MUL* 

16, 248537744, SUB, 

4561 3231 9* RSQ,/, 6, 2 497075488, SUB* RSQ, OUP, 

36 100 3565256, MUL* CHS,, 136 38 1360679, ADD, MUL* ADD, 



) 

THEN 
ELSE 



P(X,/) 

IF Q = 



HI 

IF S THEN 

PCRTNJI 

PMAX * * : 

MMAX *** 

PI Hi 

PI2 *** 



THEN PCX*/, CHS) 

ELSE PCX*XCH*/*CHS); 



PCCHS)? 

90777777 
92777777 
01143110 
01141444 



777777777; 
777777777} 
375524210; 
176652104; 



06100000 

segment; DISK 

06100100 
06100200 
06100300 

06100400 
06100500 
06100600 
06100700 
06100800 
06100900 
06101000 
06101100 
06101200 

06101300 
06l0j400 

06101500 

06101600 

06101700 

06101800 

06101900 

06102000 

06102100 

06102200 

06102300 

06102400 
06102500 

06102600 
06102700 



T 0000*0 
ADDRESS * 



00510 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 

T 
T 
T 
T 
T 



0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0003*2 
0006*3 
0012*2 
0017*3 
0019*0 
0019*0 
0022*1 
0022*3 
0024*2 
0026*1 
0026*3 
0028*3 
0037*3 
0040*1 
004113 
0041 »3 
0042*3 

0043*0 
0044*0 
0045*0 
0046*0 



i 

• 







PIA : s : 
END TAN; 



*ll56220773250«2i; 



06102800 T 0047*0 
06102900 T 0048*0 

SIZE* 0049 WORDS 



PROCEDURE CCITAN 



% 112 



START OF REl 



comment cotangent intrinsic/ 
begin real t ; 

Real x = -i; 

label pmax* 

if ct*pcmks,intcallcx#tani)))ao 

Else pci#t»/)J 

P(RTN)* 

PMAX 1*1 90777777777777777} 

END cotan; 



% PF MAY 67 



then pcpmaxj 



06200000 
SEGMENT) DISK 
06200100 
06200200 
06200300 
06200400 
06200500 
06200600 
06200700 
06200800 
06200900 



T 0000*0 
ADDRESS * 



000010 
0000*0 
0000*0 
OOOO'O 
000080 
000410 
0005*1 
0005*2 
0007*0 



00512 



SlZE= 0008 WORDS 



PROCEDURE DATAN J 



• 
• 



COMMENT DOUBLE PRECISION 

begin Real x ■ -i> 

XL = '2* 

JUNK - 17* 

t; 
boolean s>u*y; 
label sr3#sr3l>pi6,p 

g>gl»h»hl#i*il 
define am = nop, qla,t, junk 

IF S ♦ X.tllU THEN X * P( 
IF Y * x > 1 THEN P(0,1#XL 
IF U *■ X > .2679491924311 

DL 
P(XL*DUP*X»XOH#X/DLM*, JUNK 
** P(LL,L,AM,KL,K,SM,JL,J, 
DLfO/AM^CL'C^SM^BL'R, 
IF U THEN P(JUNK*PI6L,PI6» 
IF Y THEN P(JUNK,PI2L,PI2> 
IF S THEN PCJUNK/CH3*. JUNK 
PCRTN); 

SR3 :s: PH41566636564130 
Pl6 is: PH54140522160265 
PI2 '«« ?U' ! »1444l76652l04 
M Hi P316140U24046414 
L Ml ?H62303273323564 
K SS: ^1162605113035023 
J III $1163027321345406 
I It* P1163274446267506 
H ::: Pi 163607415673413 
G III P1164210421Q20314 

F III 011,64730473047014 
E SS: 0H6564272135O561 



% 113 



ARC TANGENT INTRINSIC* % PF JUNE 



START OF 
67 



I6L>PI2,PI2 

r J*JL*K,KL* 
,N0P,DLM#, 

X*SSP)* 

>X*DLQ' »X*S 

THEN PCSR3L 

D*DLS* »X*ST 

,STD*.T,STN 

AM,IL*I#SM, 

AM#AL>A,5M, 

DLA*.JUNK,S 

DLS*CHS,.JU 

j>STD)* 

* SR3L 

* PI6L 

* PI2L 

* ML 
i LL 

* KL 

; jl 

; il 

; hl 

; gl 

* FL 

; el 



l»a#al*b#bl»c»cl*d#dl»e#ei#f,fu» 

l^ll^mjMl; 
sm = nop, dls,t, junk, nqp*dlm#; 

td».xl*std); 
»sr3#0»4*5r3l#sr3*xl»x#du# 

D#.XL>STD)J 

»junk»ml#m,dlm)j 

hl,h,am,gl>g,sm,fl,f,am,el,e,sm, 

0*i*dla*xl#x#dlm» # junk*std)j 

TD)i 
NK,STD)J 



I*: 

i 



: 
: } 

1 1 
t : 
s I 

5 I 

I S 



0000 
0000 
0000 
0000 
0000 
0000 
0000 
0000 
0000 
0000 

0000 
0000 



231251 
633130 
132141 
407276 
163026 
430155 
332632 
146441 

142425 
173771 

626626 
646744 



6354455; 
2145566* 
0646H3J 
4260344J 
2103372* 
3367304* 
3362544* 
1354576/ 
6207512; 
6236562; 
0505571* 
3753240; 



06300000 

rel segment; DISK 

06300100 
06300200 
06300300 
06300400 
06300500 
06300600 
06300700 
06300800 
06300900 
06301000 
06301100 
06301200 
06301300 
06301400 
06301500 
06301600 
06301700 
06301800 
06301900 

06302000 
06302100 
06302200 
06302300 
06302400 
06302500 
06302600 
06302700 
06302800 
06302900 
06303000 

06303100 
06303200 



T 0000*0 
ADDRESS ■ 



00513 



T 

t 
t 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0003*3 
0007*3 
001113 
0013»1 
0016*3 
0033*0 
0043*0 
0045*1 
0047*3 
0049*2 
0049*3 
0052*0 
0054*0 
0056*0 
0058*0 
0060*0 
0062*0 
0064*0 
0066*0 
0068*0 

0070*0 
0072*0 



• 
• 



c * 



D 
C 
8 
A 
END 



: : : 



0116707070^070707; QL 

pusiiiiiumiii; cl 

Pll5H63ia63l463i; Bl_ 

^1152525252525252; AL 



OATA-NJ 



Hi 00000552165603175* 

Hi ^000X111051232710; 

*8S 90004631463070633; 

*$l P0005252525252470; 



06303300 
06303400 
06303500 
06303600 
06303700 



T 

T 
T 
T 

T 
SIZE 



007ft*0 
0076*0 
0078*0 
0080*0 
0082J0 
* 0084 



WORDS 



PROCEDURE ATAN2 t 



% 114 



COMMENT ARC TANGENT OF A/8 INTRINSIC; 
BEGIN 

Real 



START OF REL 



* PF MAY 67 



IF B 



ELSE 



A a "2i> Q - " 1 ; 
LABEL PI#PI2*MPig; 
> THEN 

IF A/0 THEN PCMKS#INTCALLCA/B/ARCTaND) 
ELSE PCO) 



IF B 



ELSE 



< 9 THEN 

IF A>0 THEN 

ELSE 

IF A<0 THEN 
ELSE P(PI) 



P(MKS^INTCALLCA/B,ARCTANI)*PI»ADD) 

PCMKS*INTCALLCA/B#ARCTANI)#PI,SUB) 



P(RTN); 
PI :s 

PI2 i ' 
MPI2 M 



IF A 
ELSE 



< THEN 

P(Pi2); 



Pll43n0375524210; 
91141444176652104; 
P3141444176652104; 



ENO ATAN2; 



P(MPl2) 



06400000 

segment; DISK 

06400100 
06400200 

06400300 
06400400 
06400500 
06400550 
06400600 
06400650 
06400700 
06400750 
06400800 
06400850 
06400900 
06400950 
06401000 
06401050 
06401100 
06401200 
06401300 
06401400 
06401500 



T OOOOJO 
ADDRESS = 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*3 
0005*0 
0005*1 
0005*3 
0007*0 
0011*3 
OOU » 3 
0016*2 
0017*1 
0017*1 
0019*1 
0020*0 
0020*1 
002250 
0023*0 
0024*0 



00516 



• 



SIZE= 0025 WORDS 



• 
• 



PROCEDURE DATAN2* 



• 



COMMENT DOUBLE 
BEGIN REAL B = 
BL = 

A *f 

AL ■ 
JUNK 



% 115 



ARC TANGENT OF A/8 INTRINSIC; % PF 



START OF 
JUNE 67 



PRECISION 

i -1* 

-3* 

= 17 ; 

LABEL PI»PIL»Pl2*MPl2,Pi2t; 
IF A i AND 8 i THEN 

BEGIN PCMKS»AL>A*8L*B>0LD*CALLINT<DATANI)) ; 

IF B.CUH THEN IF A > THEN P (JUNK* PIL*P I* OLA* , JUNK, STD*RTN ) 
ELSE P(JUNK*PIL#PI*DLS,,JUNK*STD*RTN); 
END ELSE 
IF B = THEN IF A.. 1 1 M 3 THEN P CMP 12, , JUNK* STD, P I2L>RTN ) 

ELSE PC PI2*.JUNK*STD#PI2L*RTN) 
ELSE IF B.CUli THEN PC P I, » JUNK, 5T0*P IL#RTN ) 

ELSE P(0,.JUNK,STN,RTN); 
PCRTN); 



06500000 
REL SEGMENT; DISK 
06500100 
06500200 
06500300 
06500400 
06500500 
06500600 
06500800 
06500900 
06501000 
06501100 
06501300 
06501500 
06501600 
06501700 
06501800 
06501900 
06502000 



T 0000*0 
ADDRESS m 



00517 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0001*3 
0005*2 
0009*3 
0012*0 
0012»0 
0016*1 
0018*0 
0021*0 
0022*2 



n 



• 



Pi *** §ll43ll0375524210; 
PI2 "5 §1141444176652104; 
MPI2 J»J §31414441766521041 
END 0ATAN2; 



PIL 

PI2L 



:S! §0002643021514230^ 
tit §0001321410646113; 



06502100 T 0022*3 
06502200 T 0025 SO 
06502300 T 0027*0 
06502400 T 0028*0 

SIZE* 0029 WORDS 



PROCEDURE ARSIN 



% 116 



CQMME 
BEGIN 



IF S 
IF X> 
IF U* 

else 



: 



PC 



IF U 
IF S 
PCRTN 
PI2 

A 

C 

E 

G 

I 

K 

M 

end 



NT ARC S 
REAL X 

xs 

BOOLEAN 

LA8EL P 
DEFINE 

<- X.tlli 
1 THEN P 
X>PCHAF) 

XSo «■ Xx 
NOP*A#XS 

H# 
I' 
PCD 
PC C 



THEN 
THEN 

j; 



»nii 

§1172 
§1173 
§1174 
§1175 
§1161 
§1161 
§1164 

rsin; 



INE I 
= -l> 

q; 

s>u; 

12, HA 
TIMES 

3 THE 

CMKS, 

THEN 

x; 

Q»MUL 
TIMES 
ADD'X 
UP, AD 

hs>; 

44417 

50672 
23206 
22736 
72417 
07047 
74343 
63146 



NTRINSIC; 



% PF MAY 67 



START OF REL 



f,a,b*c,d,e*f>g»h,i#j,k,l*m,n; 

a AnD>XSQ,MUL#; 

nx*. pcx#ssp); 
intcallc26»f0rterri)) ; 

X*PCMKS*l#X#SUB»HAF/MUL*tXSQ*STN»CAttlNT(SQRTI)) 

# B* T IMES,C* TIMES* D'TIMES*E*TIMES#F>TIMES#G* TIMES* 
, I,TIMES,J,TIM£S,K,TIMES*L#TIMES,M,TIMES*N,TIMES* 
*MUL)i 
D*CHS#PI2*ADD); 



6652104J 
1410650; 
1727030; 
3636 371; 
0360740; 
3047305; 
4343434; 
31^6315; 



HAF 
B 
D 
F 

H 
J 

L 
N 



?SJ §1154000000000000; 

**i §H7274055664H35; 

** §3.173574736467510; 

J* §1174776745032742; 

'» §U77H463l463l46; 

** §1161335056427214; 

s J §n62666666666667; 

a §1151252525252526; 



06600000 


T 


0000*0 


segment; DISK 


ADDRESS c 


06600100 


T 


0000*0 


06600200 


T 


0000*0 


06600300 


T 


0000*0 


06600400 


T 


0000*0 


06600500 


T 


0000*0 


06600600 


T 


0000*0 


06600700 


T 


0000*0 


06600800 


T 


0003*2 


06600900 


T 


0006*3 


06601000 


T 


0012*1 


06601100 


T 


0014*2 


06601200 


T 


0022*0 


06601300 


T 


0029*0 


06601400 


T 


0030*0 


06601500 


T 


0032*0 


06601600 


T 


0033*0 


06601700 


T 


0033*1 


06601800 


T 


0036*0 


06601900 


T 


0038*0 


06602000 


T 


0040*0 


06602100 


T 


0042*0 


06602200 


T 


0044*0 


06602300 


T 


0046*0 


06602400 


T 


0048*0 


06602500 


T 


0050*0 



©0518 



SIZE* 0051 WORDS 



• 



PROCEDURE ARCOS I 



% 117 



START OF REL 



COMMENT ARC COSINE INTRINSIC; 
BEGIN REAL X = -1 * 

LABEL PI2* 
IF ABSCx)>l THEN P C MKS, INTC ALL C 25, FORTERR I ) ) ; 

PCPI2,MKS,INTCALLCX,ARSINI),SUB) ; 

PCRTN); 
PI2 «** §1141444176652104; 
END ARCOS; 



% PF MAY 67 



06700000 

segment; DISK 

06700100 
06700200 
06700400 
06700500 
06700600 
06700700 
06700800 
06700900 



T 0000*0 
ADDRESS 9 00520 



0000*0 
0000*0 
0000*0 
0000*0 

0003*2 
0006*0 

0006*1 
0008*0 



SIZE* 0009 WORDS 



PROCEDURE SINH 



% 120 



06800000 T 0000*0 



• 
• 



^ «. ry 



COMMENT HYPERBOLIC SINE INTRINSIC; % pF MAY 67 

BEGIN REAL X - -1 i 

boolean s; 
label emax; 

DEFINE SUM m /,1*AD0*MUL#; 

IF S ♦ X.C1U3 THEN X *• P(X*SSP); 

IF X>PCEHAX) THEN P(MkS#INTCALLC29#F0RTeRRI)) I 

IF X < ,5 THEN 

P(X*QuP*DUP*MUL»DUP,DUP*0UP*72*SlAM,42*SlAM*20*SlAM*6*SlAM) ELSE 

P(MKS*INTCALLCX*EXPp*0UP#l*XCIW*SUB,,5*MUL) J 
IF S THEN PCGHS); 
P(RTN); 
EMAX s:« f U22360OOO000000; 

end sinh; 



START OF REL 



SEGMENT; DISK 
06800100 
06800200 
06800400 
06800500 
06800600 
06800700 
06800800 
06800900 
06801000 
06801100 
06801200 
06801300 
06801400 
06801500 



ADDRESS • 00521 



m 

m 



OGQO*0 
0000*0 

oooo*o 

0000*0 
0000*0 
00001-0 
0003*0 
0006*1 
0007*0 

ooun 

0019*3 
002013 
0021*0 
0022*0 






SUE 5 ? 0024 WORDS 



PROCEDURE COSH 



% 121 
COSINE INTRINSIC; 



% PF MAY 67 



START OF REL 



comment hyperbolic 
begin real x * -i* 
t; 
label emax; 
define s1am = /, 1, add* mul#; 
if (t«.a8s(x))>p(emax) then pc mks* intc all < 30*f0rterri ) ) ; 

IF T < .75 THEN 

P<X*DUP*MUL*DUP*DUP*0UP,DUP*9G*SlAM*56*SlAM*30*SlAM*12*SlAM, 

t5*MUL»l*ADD) ELSE PC MKS* INTCALL(X*EXPI)*DUP*i*XCH,/,ADD* ,5* mud 
PCRTN); 
EMAX *** ^1122360000000000; 

end cosh; 



06900000 

segment; disk 

06900100 
06900200 
06900300 
06900400 
0690Q500 
06900600 
06900700 
06900800 
06900900 
06901000 
06901100 
06901200 



T 0000*0 
ADDRESS m 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0004*1 
0005*0 
0012*1 
0019*3 
0020*0 
0021*0 



00522 



SIZE" 0023 WORDS 



• 



PROCEDURE TANH ; 



% 122 



07000000 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS m ©0523 



comment hyperbolic tangent intrinsic; 
begin real t ; 

REAL X " -i; 

boolean 

IF S * X, [1*13 

IF X ■■■> 27 THEN 

IF X < ,14 THE 

P(X#DUP#DUP> 



% PF MAY 67 



then x «. p(x*ssp>; 

if s then pcl*chs*rtn) else pq*rtn); 

:n 



ELSE PCMK 
IF S THEN 
P(RTN)J 
END TANH/ 



S*INT 
P(CH 



MUL * DUP*DUP*DUP* 6 » 8888888689* MUl* 17* SUB* 

MUL*21*/*2*ADD*MUL»5*/*l*SUB*MUL*3*/*l*ADD*MuL) 
CALLCX*EXPI)*DUP* ,T* STN* 1, XCH* /*DUP* T* ADD* ,T* STO* SUB* T* />; 

S3; 



07000 
07000 
07000 
07000 
07000 
07000 
07000 
07000 
07001 
07001 
07001 
07001 
07001 



100 
200 
300 
400 
600 
700 
800 
900 
000 
100 
200 
300 
500 



T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 

size* 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0003' 1 
0007*0 
0007* 3 
0011*0 
0015*0 
0023*2 
0024*2 
0024*3 
0025 



WORDS 





# 



PROCEDURE DSORT * 



% 123 



comment ooub 
begin real x 

X 
J 

Label 
if x leo o t 

PCX|_*X»0>MKS 
STO»RTN) ; 

haf ;; : ?n 

end dsqrt; 



LE PRECISION SQUARE ROOT INTRINSIC; % PF JUNE 

= -1, 
L = "2* 

unk = 17 ; 

haf; 

HEN IF X = 

ELSE P(MKS»INTCALL(27#F0RTERRD) ; 

* intcallcx, 



START 

67 



THEN PCQ* ,JUNK*STN*RTN) 
■MKS»INTCALL(27#F0RTERRD) 



SORT I), .JUNK,STN,DLD*0*JUNK,DLA*0*HAF*OLM* ,JUNK* 
54000000000000; 



07100000 
OF REL SEGMENT; DISK 

07100100 
07100200 
07100300 
07100400 

07100600 
07100700 
07100710 
07100800 
07100810 
07100900 
07101000 



T 0000*0 
ADDRESS * 



0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0003*2 
0006*0 
001H1 
0011*3 
0013*0 



00524 



SIZE* 0014 WORDS 



i 

i 
« 

i 
i 
i 
i 



• 



% 124 
ROOT INTRINSIC; % PF JUNE 67 



PROCEDURE CSQRT ; 
COMMENT COMPLEX SQUARE 

begin Real x = -l* 

Y s -2, 
JUNK * 17 ; 
LABEL HAF; 
IF X b THEN IF Y s THEN PCO* . JUNK*STN, RTN )} 

pcmks,intcallcpcmks,x,intcallcy*cabsi)*x#ssp*add*haf*mul)*sqrti)) 
if x > then pc. junk, stn, dup* add* y, xch, /* rtn) 
else begin if y , c 1 ; 1 ] then pcchs); 

pcdup*dup*add,y,xch,/, , junk, std* rtn ) ; 

end; 

HAF *»5 <»1154000000000000; 

end csqrt; 



START OF REL 



07200000 

segment; DISK 

07200100 
07200200 
07200300 
07200400 
07200700 
07200800 
07200900 
07201000 
07201100 
07201200 
07201300 
07201400 
07201500 



T 0000*0 
ADDRESS a 00525 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0003*2 
0008* 3 
0012»0 
0014*0 
0016*1 
0016*1 
0018*0 



SIZE* 0019 WORDS 



PROCEDURE ERF 



% 125 



3! PF MAY 67 



START OF REL 



COMMENT THE ERROR FUNCTION INTRINSIC; 
BEGIN REAL X = -1* 

xsq,t*w; 
label a*b*c,d*e,f*g*h*i,j,k,l*m,n,over*msrtpii 

DEFINE MORE = ADD/XSQ, MUL#, LESS s SUB,XSQ* MUL#; 
IF CXSQ * XxX) < 2.22 THEN 

J: P C NOP, A, XSQ* MUL*R,LES5,C, MORE *D* LESS, E* MORE* F, LESS, G*MQR£,H, LESS, 

I * MORE* J, LESS*K, MORE, L, LESS* M* MORE* N* LESS* OVER* ADD* X*MyuRTN); 
IF XSQ < 24 THEN 

BEGIN W ♦• (XSQ + l4.5)x(T *. XSQ + 6.6267867473) - 39,1779586414; 

T <- (XSQ + 12,5)XW - 45.5XT; 

W <■ CXSq + i0.5)xT - 33xW; 

T *■ CXSQ + 8.5)xW - 22,5xT* 

W «■ (XSQ + 6.5)xT - 14xW; 

T <■ CXSQ + 4.5)xW - 7,5xT; 

W «• CXSQ + 2.5)xT - 3xw; 

T * (XSQ + ,5>*W - ,5xT; 



07300000 

segment; DISK 

07300100 
07300200 
07300400 
07300500 
07300600 
07300700 
07300800 
07300900 
07301000 
0730H00 
07301200 
07301300 
07301400 
07301500 
07301600 
07301700 
07301800 



T 0000*0 
ADDRESS « 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0002*2 
0011*0 
0018*1 
0019*0 
0022*3 
0025*2 
0028*1 
003l«0 
0033*3 
0036*2 
0039*1 



00526 



*< »•■ 



m 



END 
IF X 
PCRT 



C t 
E ? 
G 

I 



J J 
! ! 



K ? : 
M * * 
OVER at 
end erf; 



P(AB 
ELSE 
,C1; 
H)} 
' *1 
i Pj 

: Pi 

: ?! 

8 Pi 

: Pi 
* *1 



SCX)*W*MUL*MKS* lNTCALLCXSQ*EXPl)#MSRTPl*MUL'T#MUU*/#i*ADD) 

pcd; 

u then pcchs); 



321164756260433; B 

306316666647563,* D 

251771347130371; F 

233347466027367; H 

213746431157302; J 

172531336320715; (. 

I67l6i3620640i6; N 
91141101565650103; 



!«* P1313314675626043; 

J«! P126124272543H73; 

S!5 P1242575635313531; 

!*? P1223723222675344; 

J J! P1203400555500006; 

85! P1161560263430450; 

jjs PH53004472153007; 
MSRTPISJJP314 16133761 10665; 



07301850 
07301900 
07302000 
07302100 
07302200 
07302300 
07302400 
07302500 
07302600 
07302700 
07302800 
07302900 
07303000 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SIZE 



0042'0 
0046 J 3 
0062U 

0063»3 
0064»0 
0066*0 
006850 
0070 10 
0072*0 
0074*0 
0076*0 
0078*0 
0080*0 
- 0081 



WORDS 



PROCEDURE GAMMA 



% 126 



% PF MAY 67 



COMMENT GAMMA INTRINSIC; 
BEGIN REAL X s -1, 

e*v*y; 

BOOLEAN S; INTEGER K; 
LABEL L1*PMAX*MMAX*PI*MPI; 
DEFINE SUBMUL s 5UB*E*MUL#* ADDMUL 
IF S «■ X < THEN X «■ PCX*SSP)* 
IF X>52 THEN PCMKS*INTCALLC28*F0RTERRI>) i 
IF (E «■ PCX*DUP* ,Y*5ND* .5*SUB*»K*ISN*SUB)3 s THEN 

BEGIN IF S THEN IF K. [47*11 THEN P(MMAX)ELSE P<PMAX) 
ELSE IF K < 2 THEN PCI) 

ELSE GO TO Li; 



START OF REL 



■ ADD'E*MUL#, 



IF 



ENH; 
K < 2 



pcrtn); 

THEN V «■ 
ELSE LI 



(IF K «= THEN P(1*X#DUP.»1»A00*MUU»'/) 
IF K = 1 THEN 1/X ELSE 1) 



ELSE 



- (V «■ 1 >J 

Xxy UNTIL CX * X 
THEN P(V*RTN); 



* 1) < 2, 



BEGIN X «• X 
DO V «• 
IF E * 

end; 
'• * pcnop*e* .000067 7 1q571 17 *mul' 

,000 34 4 2 34 20456* SUBMUL* 

.0015 39768 10472* ADDMUL* 

,00246674798054 'SUBMUL' 

.0109736958417, ADDMUL* 

,000 210907 46 7 31* SUBMUL* 

.0742 3790 760 6* ADDMUL* 

.081578218785*ADQMUL, 

,4H84025l796*ADDMUL* 

,422784336962*ADDMUL* 

, 99999999999 > ADD *V,MUL*.V*STN); 

IF S THEN P(OEL*MPI*MKS*lNTCALLCPCPI)xY,SlNl)*V»MUL*Y»MUL*/J 

PCRTN); 

PI *** P1143110375524210; 

MPI *J* P3143110375524210; 

PMAX *:: $0777777777777777} 

MMAX **J $2777777777777777'* 



07400000 
SEGMENT; DISK 
07400100 
07400200 
07400400 
07400500 
07400600 
07400700 
07400800 
07400900 
07401000 
07401100 
07401200 
07401300 
07401400 
07401500 
07401600 
07401700 
07401800 
07401900 
07402000 
07402100 
07402200 
07402300 
07402400 
07402500 
07402600 
07402700 
07402800 
07402900 
07403000 
07403100 
07403200 
07403300 
07403400 
07403500 
07403600 
07403700 
07403800 



T 0000 
ADDRESS 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000 
0000 
0000 
0000 
0000 
0000 
0000 

0004 
0007 

0010 

0015 
0017 
0017 
0017 
0017 
0022 

0025 
0027 
0031 
OO33 
0033 
0034 
0035 
0036 
0037 
0038 
0039 
0040 
004i 

0042 
OO43 
0044 
0049 
0049 
0051 
0052 
0053 



*0 
s 
JO 
*0 
*0 
»0 
*0 
*0 
10 
*0 

u 

*2 

n 
*i 

*i 

*2 
*2 
*1 

*0 
*3 

n 
*o 

."10 
*0 
*0 
*0 
*0 
10 
*0 
*0 
*0 
JO 
*0 
*2 
*2 
*3 
*0 
JO 
JO 



00529 



end gamma; 



07403900 T 0054*0 

SIZE* 0066 WORDS 






PROCEDURE ALGAM'a; 



% 127 



% PF MAY 67 



START QF REL 



COMMENT LOG GAMMA INTRINSIC; 
BEGIN REAL X a -1, 

t; 

define submul = sub*t,mul#, adomul. = add*t,mul#; 
if x leo then p c mks, intc all( 31 + ( xxo ) , forterri ) ) ; 
if x<3.?8 then pc mks , i ntc all ( p ( mks, i ntc allc x, g amma i ) ) ,lni) *rtn } 
pc1,x,dup,mul*/, .t*sno); 
:: pcnqpm. 392432216906, chs, mul, 

.179644372369, ADOMUL, 
.0 2955065 35948, SUBMUL, 
.006^10256410 3, ADDMUL, 
.00 19 175269 175 3* SUBMUL, 
.00084175084175*ADDMUL, 
.0005952 3809524* SUBMUL, 
,00079 365079 365^ ADDMUL, 
.00 27777 7777778* SUBMUL, 

.08 333 3333 3 3 3, ADD *X,/,. 9 189 385 3321, ADD, 
X,DljP>,5,SUB,MKS,INTCALL(X,LNn,MUL,XCH,SUB*ADD) 

PCftTNj; 

end algama; 



07500000 

segment; disk 

07500100 
07500200 
07500400 
07500500 
07500600 
07500700 
07500800 
07500900 
07501000 
07501100 
07501200 
07501300 
07501400 
07501500 
07501600 
07501700 
07501800 
07501900 
07502000 
07502100 



T 000050 
ADDRESS * 00532 



T 

T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0004*2 
0009*3 
0011*2 
0013*0 
0014*0 
0015*0 
0016*0 
0017*0 
0018*0 
0019*0 
0020*0 
002i?0 
0022*2 
0026*2 
0026*3 



• 



SIZE* 0040 WORDS 



PROCEDURE ANDI ; 



BEGIN 

REAL A » * 1,B : 
PCA AND 8,RTN>> 
END ANDI J 



X 130 



*2i 



START OF REL 



07600000 

segment; disk 

07600100 
07600200 
07600300 
07600400 



T 0000*0 
ADDRESS ■• ©0534 
T 0000*0 
T 0000*0 
T 0000*0 
T 0001*0 
SIZE* 0002 WORDS 



PROCEDURE ORI 



% 131 



BEGIN 

REAL A =-1*8 = 
PCA OR B,RTN); 
END OR I J 



-21 



07700000 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS ■ 00535 

07700100 T 0000*0 

07700200 T 0000*0 

07700300 T 0000*0 

07700400 T 0001*0 

SIZE" 0002 WORDS 



PROCEDURE CMPL 



% 132 



07800000 
START OF REL SEGMENT; DISK 



T 0000*0 ' 
ADDRESS ■ 00536 



+ 4 



/Jt u 



-*■ If 



•p:*"* 



BEGIN 

REAL A = - U 
PC (NOT A)>RTN)J 
END CMPLJ 



07800JOO T OQOO*0 

07800200 T 0000*0 

O78OO3OO T 0000*0 

07800400 T 0000*3 

size* 0001 words 



PROCEDURE EQUIVP; 



% 133 



• 



BEGIN 



START OF REL 



REAL A*-1*B * -2; 
P(A EQV B'RTN); 
END EQUIVP; 



07900000 
SEGMENT* DISK 
07900100 
07900200 
07900300 
07900400 



T 0000*0 
ADDRESS * 00537 
T 0000*0 

T 0000 ;o 

T 0000*0 
T 0001*0 
SIZE* 0002 WORDS 



PROCEDURE FORTERR/ 



% 134 



RUN-TIME ERRORS 



START OF REL 



OS* 
CODES 



LABEL 
LABEL 



• 



BEGIN 
COMMENT PROGRAM GENERATING VARIOUS ERRQR MESSAGES WITH 
CODES THRU 3 ARe USED BY THE FORMATING INTRINSICS, 
10 THRU 32 ARE USED BY VARIOUS MATH INTRINSICS; 

REAL CODE * "1*FID»MFID^ IND#BUFF#Aa*2#8s-3,Ca*4#D*"5# 
ARRAY TPAR[*]»FIB[*]»FPBs3t*] ; 
NAME MEM s 2; 
CD* F095* CD1* CD2» 0C> DC1* DC2> G095 1 

CPLR#XT0NCSSC»0M0D#DEXP»CExP#0LGZ»0L6M»CL06»ALTZf ALTM»DLTZ*DLTM# 

csin#ccos^cosms in* dsqr»gama>sinh* cosh* algz*algm,maxn* Zero* ngtv* 
lo*li#l2>l3,lx#wrapup*figer; 
label in, 15, L6; 

SWITCH SWl «- LO, Ll# L2> L3, L4, L5, L6; 

SWITCH SW2 «- CPLR*XTQI,CSSC#DM0D*0EXP*CFXP,0LQZ^DL6M#CL06»ALTZ,ALTM# 

dltz,dltm,csin*ccos,acos,asin,dsqr,gama,sinh,cosh,algz,algm; 
define strem = stream(d «• ctparc#, sto = strem 033)#* st2 « strem 233)*; 

DEFINE CC55CCC551) * CC551 CDS*L I T M <«; Sl*Ai; DS+A13 CHR; DS«-LIT«>«) *, 
NAS(NASl»NAS2*NAS3) = SI*LOC NASi; DS«-NAS2 DEC; NAS3C DI*DI-4 ; 

DSi-LlT"*") *> 
CD5(C05l,cn52»C053,CD54,CD55) = CC55CCD51); CD52CNAS(CD53*CD54 f 

CD55)) #» 
SAVWcF ## SAVD*E #* WH2*B #* WH1*C $* R*6 #; 
SUBROUTINE GETFILE* 
BEGIN 

FIB *■ MEM tC WOT 2) INX A3; 
MFID <■ FPBLINO «■ FI Bt 4 3 . [1 3 *1 1 3 3; 
FID <• FPBCIND + 13; 
B <- B + i; 
END GETFILE ; 

REAL T1#T2>T3/T4»T5*E = -6#F S -7,G S -8#H S "*9#I=»10»J = -11*K3;"12 ; 
INTEGER IT2*T2 ; 
ARRAY TFNc22t*3 ; 
LABEL LOOP, ALFA I 
REA L SUBROUTINE SlZ * 
BEGIN 



07900410 

segment; disk 

07900500 
07900600 
07900700 
07900800 
07900900 
07901000 
07901100 
0790U10 
07901200 
07901300 
07901400 
07901410 
07901500 
07901600 
07901700 

07901800 
07901810 
07901820 
07901825 
07901830 
07901835 
07901850 
07901900 
07902000 
07902100 
07902200 
07902300 
07902400 
07902405 
07902410 
07902415 
07902417 
07902420 
07902425 
07902430 



T 0000*0 
ADDRESS = 



T 
T 
T 

T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 
T 
T 
T 
T 
T 
T 



0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
OOOl JO 

0001*0 
0003*1 

0005*2 

0007*0 
0008*1 
0008*2 
0008*2 
0008*2 
0008*2 
0008*2 
0009*0 



00538 



i 

i 
i 
1 
% 
m 



m 



* * 



ten ct3] -ten [68 3 * t1*0 / 
loop* if tenct1*tu1]st2 then go loop; siz*t1 '* 

end of siz ; 
%************.<** program starts 
tpar<-p( [ tpare 133 >cfx*sfb hue 8* 38*103 ; 

IF cODE=(-2) THEN 

BEGIN T3«-5; T2«-B } 
STREAMCE»D^C,B#A,N3«-PCALFA)*N1*SIZ*T2*T2*A#N2*SI2#TPAR) 

BEGIN 

QS*15UT"«DATA STMT ERR*'M SI*L0C E; DS«-DEC 



DS«-«LlT«*tTs"; S!*lOC N31 Sl*Sl*OJ DS*CHR 
QS<-4LlT",DTs"; SI*L0C N3I SI*SI+C; DS«-CHR 
D : S*3LIT"/L»"J SI«-LQC B) DS*N1 DEC i 

DS*N2 DEC; DS*2LIT M !<." } 



} 



m 



IF 



DS*33LIT"-MIXD UNFMT/ALPHA-MODE TAPE I/0«*" 



IF 



• 
• 



ALPA' » » 
DCS * * 
G095* tl 

IF 



DS«-3llT M *D = "; 

end ; 
GO wrapup ; 

END '> 
CQDE=(-1) THEN 
BEGIN 

streamctpar); 

GO WRAPUP i 

END I 
CODEsC-3) THEN 

BEGIN T3<-4; T2*is F 1 0* C Mp 1 0*PC G095 ) ) "1 ', 

STREAMCJ#K#I,F1*SIZ»D«-T2*H*F2*SIZ*F3#-G>10 AND 15>G»F, 
N3*PCALFA)iiCl*IT2«.E#C*SiZ#Rl«-IT2*0+l>R*SlZ# 
BUFF*C*V*B.Cft2«l3 AND B . E46 *2 ]»0i A4«-T2«-8 , E 6 » 12 ] , A5*SIZ 
xi4.T2/l#A55*J*(K*T2)«MFlD#A2*(T5*B AND 15 >*X2 OR T5*8, 
A3«-T5 = 12 OR T5*4>CD*PCDC>#CD1«-PCDC1)>Z«-0,CD2*P<DC2), 
A6<-(T4«.B,Cl{5]5"2*A7«-T2«.B,(:i8J123/.A8«-SIZx(CT4/30 OR 
T2XFID) AND (T4*9 QR T2/0 ) ), A85*MFID*T2# A9*T4*H AND 
T4<14 OR CT4=30 AND ( T2*B , C 30 I 1 2 3 >*FID )> AlO*T2, A11*S lit 
A115«-T2 S MFID>A12«-T2*IF J THEN A.E18S153 ELSE K, 
Al3*-Si2xl,TPAR) > 
BEGIN DS*11LIT"-DATA ERR $») SI*LQC J} SI+SI+7; DS*CHR ; 
DS«-2LlT"a »; V<NAS(A4,a5,a55); A2( DS*LIT"K*' )} A3(DS*llT 

»$»•); si*loc cd; si«-si + A6; ds*chr; nasca7,A8>A85) ; 

A9(DS*-HT M .«»| NAS(A10*A11,A115))I DS«.ftllT" *> "; JUMP OUT 
TO LD' DS«-7LIT«FMT IS "J LU SIHOC A12* DS*Ai3 DEC I 
A2CDS«-LIT"K"}; A3(DS«-LIT"$">; Sl«.LOC KJ! SI4-SI+7I ds*chr ; 
DS«T1 DEC/ F3(DS*LlT",»; Sl«-LOC D; DS«-F2 DEOi DS*6LlT 
" TYPa»; SI«-L0C N3; SI*Sl+F; D5*CHR; 0$*6LIT"# COL#" i 

ds*-c dec; ds*6UT"> chr» w ; si*buff; si*si-i; ds*chr ; 

DS«-6LIT», REC#"; SULOC RjJ D5*R DEC; DS*3UT" !*» ; 
END OF STREAM ', 

GO WRAPUP 7 

92531625143242300 ; 

"PXTAOLJ"* DC1UI £3127262524230000; 

4095 ; 

end ; 

C0DE=C-4) 
BEGIN 
IF CODE 



DC2S * X "CVOQO" ; 



THEN 



THEN 



[2*13 
BEGIN 
STREAMCTPAR); 

go wrarup ; 
end ; 



DS*24LIT"-UNINITIAUZED POINTER'*" ; 



07902435 


T 


0Q09?0 


07902440 


T 


0011* 1 


07902445 


T 


0014* 1 


07902447 


T 


0014*2 


07902448 


T 


0014*2 


07902450 


T 


0020*1 


07902455 


T 


0021*1 


07902460 


T 


0023*1 


07902465 


T 


0028*3 


07902470 


T 


0028*3 


07902475 


T 


0031*2 


07902480 


T 


0033*1 


07902485 


T 


0035*0 


07902490 


T 


0036*2 


07902495 


T 


0038*1 


07902500 


T 


0038*2 


07902505 


T 


0039*0 


07902510 


T 


0039*0 


07902515 


T 


0040*0 


07902520 


T 


0040*2 


07902523 


T 


0046*1 


07902525 


T 


0046*3 


07902530 


T 


0046*3 


07902535 


T 


0047*3 


07902540 


T 


0051*2 


07902545 


T 


0058*0 


07902548 


T 


0062*0 


07902551 


T 


0066*2 


07902554 


T 


007 3*0 


07902557 


T 


0075*3 


07902560 


T 


0080*3 


07902563 


T 


0085*2 


07902566 


T 


009i*0 


07902568 


T 


0094*2 


07902569 


T 


0097*1 


07902572 


P 


0099*3 


07902575 


T 


0105*0 


07902578 


T 


0108*3 


07902581 


T 


0113*0 


07902584 


T 


0115*3 


07902587 


T 


0119*0 


07902590 


T 


0121*3 


07902593 


T 


0124*2 


07902596 


T 


0126*3 


07902599 


T 


0129*1 


07902602 


T 


0129*2 


07902605 


T 


0130*0 


07902606 


T 


0131*0 


07902607 


T 


0134*0 


07902608 


T 


0135*0 


07902610 


T 


0135*0 


07902614 


T 


0136*0 


07902615 


T 


0136*2 


07902616 


T 


0137*1 


07902617 


T 


0137*3 


07902618 


T 


0142*1 


07902619 


T 


0142*3 



i 
i 



m 
m 
m 



*y*tt fc 



• 



• 
• 



F095S 

CD: : s 



stream(tpar); ds«-32l i t"-b i nary tape rec has < 3 wqrqsf*" ; 
go wrapup ; 
end ; 

IF c0DE=C-5) THEN 

BEGIN T3«-8; CQDE«-H ; 

IF 15 = 2 THEN BEGIN C0DE*30; IF WH1>63 OR WHKlO THEN D*12 END J 
IF A. C 1 «53<b THEN BEGIN A . [6 : 123 «■ A, E18 5 123 i R*SAVW; 0*10 END 1 
IF D>9 THEN 

BEGIN FIB«-PCCFIB£13]#CFX#SFB)*5C8I38J103; FI8C03*0 i 

BUFF* C (BUFFED ITITCFID*FlBtC33« 15 3*0*2* WH2»HH1)>,E33» 15 J- 

FID)*8+BUFF, [30*33 ; 
END i 
FID*(MFID«-P<F095))-I J 

IND*CnDE>14 AND CC0DE*30 OR A , [ 30 ; 12 3 -FID ) ) 
STRSAMCA1*FIB*A2*CT5*A AND 153 = 12 OR T5«8, a3«-T5« 12 QR T5s4, 

A4«-T2*A,[6»12]f A5*SlZxT5*T2J'l#A55«-T2«MFID»A6«.(T4*At[ll53 
)-2#A7«.T2«-A.C18»l2]#A8*SIZx CT4*29 AND T4X3 AND T4*4 
AND (T4X30 QR T2* FID) AND (T4X9 OR T2*0 ) 3* A85*CT2s 
MFIO) ,A9«-T4>11 AND T4<14 OR <T4s3Q AND ( T2*A, I 30 f 12 3 ) 
i FID),A10«-T2* All«-SIZ,Ail5«.T2*?MFID,A12«<T4*3 AND A,C41H] 
#R10*D«10#R*DX10#RUT2«-R#R2*SlZxT5» 
V12*0ai2* VV<-0*2 AND WH1 *3 1, V*0>2 AND 0*12* 
.Vl«-CQDE*2>SK^MD*C-0DE«3 OR CODE*??.? OR CCG0E*3Q AND 
SAVWs FID) OR C0DE=4 QR (C0DE«9 AND SAVWsO) *H 1 4*0*14* 
W*D*14*WW*SAVN«FID*W5«.'SaVH-MFID*SKPD*C0DE 
<11 9R IND*D16*0=16,D*D/16,0D«- 

SAVQ*FI0*D5*SAVD*MFID*D1«-T2*SAVD*D2*-SIZ,W1*T2<-SAVW* 
W2«-SlZ*WHl,A13«-8UFF*CD*P(CD)*C0l«-PCCDl)*R5«-0* 
CD2*-P(CD2)*TPAR) / 
BEGIN DS#-16LIT W »VARBU FMT ERR* "; A12C DS*IIT"* W ) i 
NAS(A4*A5*A55); A2 ( DS«-l IT"K M ) ; A3C DS«-L IT"*" ) > 
SI*LOC CD) SI«-SI + A6J DS*CHR; NAS(A7*A8*A85) i 
A9CDS*UIT". M ; NASCA10,A11,A115))J 0S*4LIT m ■> " i 
A12(DS*LIT"-"); C05(R10*R,R1*R2*R5); A2C DS*IIT M K« ); A3CDS* 

uit"$ h ); cc55(vi2); v(si*loc cd; si*si+vi; ds*chr); vvcos* 

LIT"<"; SI«-LOC HHi; SI*S!+7; DS*>CHR* DS«-tIT">");5KPWDCJUMP 
OUT TO XX)»WHCDS*ULIT"<MiSSING W> M ; SKPDCJUMP OUT 2 TO XX 
)* DI*Ol-i; DS*7LIT» AND D> M #JUMP OUT TO XX)* CD5CWl4,W,Wl 
,W2*W5); GO xv; XX* GO XT; XV* SKPD(JUMP OUT 1 TO XT); OS* 
LIT'VV 0D(DS«-11UIT"<MISSING 0> N ; JUMP OUT 1 TO XT) J 
CD5(D16,D>D1»D2#D5); XTj 0S«-3LIT" ;<•" ; 

END OF STREAM ; 
GO WRAPUP ; 
S 4095 ; 
s "PXTAOLJ"; CD1M 

END i 

IF C0DE<10 THEN GO SW1CC0DE3 ; 
GO TO SW2CC00E - 103; 
LOS % 

CTPARC033); 



P3127262524230000; CD2*** "CVOOO" ; 



STREAM(P1*Q*P2 *■ 
BEGIN 

DS «• 14 LIT 

pi *• ol; 
end; 

BUFF <• Pi 



"-FORMAT ERROR 



LIS 



GO 
% 



to lx; 



07902620 


T 


0142*3 


07902625 


T 


0148*1 


07902630 


T 


0148*3 


07902631 


T 


0148*3 


07902632 


T 


0149*3 


07902633 


T 


151* 3 


07902634 


T 


0156*3 


07902635 


T 


Ol6 2 »i 


07902636 


T 


016310 


07902637 


T 


0167*1 


07902638 


T 


017351 


07902639 


T 


0175*3 


07902640 


T 


0175*3 


07902641 


T 


0177*2 


07902642 


T 


0181S1 


07902643 


T 


0186*2 


07902645 


T 


019111 


07902647 


T 


0197*0 


07902650 


T 


0202*1 


07902655 


T 


0205*1 


07902660 


T 


0210*2 


07902665 


T 


0215*2 


07902670 


T 


0219*3 


07902672 


T 


0223*0 


07902675 


T 


0228*0 


07902680 


T 


0230*1 


07902685 


T 


0233*0 


07902690 


T 


0236*3 


07902692 


7 


0239*1 


07902695 


P 


0240*1 


07902700 


T 


0243*3 


07902705 


T 


0248*2 


07902710 


T 


0251*3 


07902720 


T 


0256*0 


07902725 


T 


0264*2 


07902730 


T 


0270*0 


07902735 


T 


0272S2 


07902740 


T 


0276*2 


07902745 


T 


0279*1 


07902750 


T 


0286*2 


07902755 


T 


0290*0 


07902760 


T 


0296*1 


07902765 


T 


0296*2 


07902770 


T 


0297*0 


07902771 


T 


0298*0 


07902775 


T 


0301*0 


07902780 


T 


0301*0 


07902800 


T 


0306*3 


07902900 


T 


0319*3 


07903000 


T 


0319*3 


07903100 


T 


0321*1 


07903200 


T 


0321*1 


07903300 


T 


0323*1 


07903400 


T 


0323*2 


07903500 


T 


0323*3 


07903600 


T 


0324*1 


07903700 


T 


0324*3 







^■B 



• 

• 



STREAM(P1«-0*D ♦ [TPARCOl])^ 
BEGIN 

DS «• 16 LIT "-NAMELIST ERROR *S 

PI «• Oil 

end; 

buff «- p; 
go to lx; 

|_2 ; % 2 

STREAM(P1*0»D * CTPARC0335I 
BEGIN 

OS «- 12 LIT "-TYPE ERROR "t 

P{ «• 01} 

end; 

BUFF 4. Pj 
LX* 

getfile; 
stream(mfid'fid»b#buff)^ 

BEGIN 

DI«-BUFF* DS*8LlT"0N FILE M J 

si «■ luc mfid; si ♦ si + i; ds * 7 chr; os * lit "/«j 

SI«-LOC FID/ SI*SI + 1I DS«-7CHR; DS«-7LIT"* Rec #« ; 

si * loc b; ds «■ 8 dec; DS * 2 LIT "U«* 

end; 

go To wrapup; 

L3S % 3 

sto; 

ds * 18 lit "-data stmt error**"; 
GO TO wrapup; 



L4$ % 



% VOID 



L5* 



L6* 



cplrj 

XTOI* 

esse: 

DMOD* 



stream(Pi«-o'd*[tparco]] ); 

BEGIN 

DS<-26LIT M "MIXED FMT/UNFMT TAPE I/O " ; 

Pi «• 01; 

end; 

buff * p; 
GO to lx; 

% 5 

STREAM(Pl«-0«D*[TPARCO]] ); 
BEGIN 

dsj = 18 lit "-list size error '•; 

pi ♦ di; 
end; 
buff * p; go to lx; 

STOJ % 6 

ds <• 21 LIT "^INVALID arg CONCaTs*"; 

go to wrapup; 

sto; % 10 

ds «• 31 lit "-expression compilation error**"; 

go to figer; 

stoj % 11 

ds «• 21 lit "-negative base xtol?*"; 

go to figer; 

sto; % 12 

ds «• 24 lit "-complex exponent xtoi**"; 
go to figer; 
sto; % 13 



07903800 
07903900 
07904000 
07904100 
07904200 
07904300 
07904400 
07904500 
07904600 

07904700 
07904800 
07904900 
07905000 
07905100 
07905200 
07905300 
07905400 
07905500 
07905600 
07905700 
07905800 
07905900 
07906000 
07906100 
07906200 
07906300 
07906500 
07906700 
07906710 
07906720 
07906730 
07906740 
07906750 
07906760 
07906770 
07906780 
07906790 
07906800 

07906810 
07906820 
07906830 
07906840 
07906850 
07906860 
07906861 
07906862 
07906863 
07906890 
07906900 

07907000 
07907100 
07907200 
07907300 
07907400 
07907500 
07907600 
07907700 



0324*3 
0326*1 
0326*1 
0328*2 
0328*3 
0329*0 
0329*2 
0330*0 
0330*0 

0331*2 
0331*2 
0333*1 
0333*2 
0333*3 
0334*1 
0334*1 
0335*0 
0336*2 

0336*2 
0338*0 

0339* 1 
0341*1 
342*j. 
0342*2 
0343*0 
0343*0 
344*0 
0346*3 
0347* 1 
0347*1 
0348*3 
0348*3 
0352*1 
0352*1 
0352*2 
0352*3 
0353*1 
0353*3 
0353*3 
0355*1 
0355*1 
0357*3 
0358*0 
0358*1 
0359*1 
0360*1 
0363*2 
364*0 
0365*0 

0369*2 
370*0 

0371*0 
0374*1 
0374*3 
0375*3 
0379*1 
0379*3 



• 
• 

• 



• 
• 



*N»..** , 



*. ,*4b. 



4 %. 



iiir '■*■■.-»'# 



»,4 



-**«» 






DEXPJ 



CEXp: 



DLGZ! 
DLGM! 



CLOG! 



ALTZ! 
ALTM: 



DLTZJ 

DLTM! 



CSIN5 
CCQSJ 



ACOSS 
ASIN: 



OSQRt 
NGTVS 

GAMA» 

SINH! 

COSH! 
MAXN: 



ALGZ? 

ALGM! 



DS «- 20 LIT "-ZERO MODULUS DMOD»*"J 

GO TO FIGER; 

ST2; % 

DS «• 6 LIT "OEXP:*"; 

GO TO MAXN; 

S T P * % 

ds «■ 6 lit "cexp:*-"; 
go to maxn; 
buff «- true; % 

ST2J X 

DS «■ 6 LIT "DL0G:*"; 

IF BUFF THEN GO TO ZERO ELSE GO TO NGTV; 

ST2^ % 

OS *■ 6 LIT "CLOG*.*") 

GO TO ZERO) 

buff * true; * 

C T p • *¥ 

ds** 8 lit "alqgio:*"; 

if buff then go to zero else go to ngtv; 

buff * true; % 

DS * 8 LIT "0L0G10S*"; 

IF BUFF THEN GO TO ZERO ELSE GO TO NGTV; 

ST2; % 

DS * 6 LIT "CSINS*"; 

go to maxn; 

ST2; * 

DS * 6 LIT "cCOS:*«; 
GO to maxn; 
buff «■ true; % 

stream(8 «- buff>d «■ [tparc03j)j % 
begin ds * 19 lit "-abscarg) »0t, 1 ar"; 
si * loc 8; si * si + 7; 

IF SC = "1" ThEN DS * 5 L 
ELSE DS *■ 5 L 

end; 

go to figer; 

ST2; % 

ds «• 7 lit "dsqrt!***; 

sto; 

ds «• 16 lit "-negatve argmnt "; 

go to figer; 

ST2J % 

ds * 7 lit "gamma!**; 
go to maxn; 

ST2; % 

DS * 6 LIT "sinh:*"; 

go to maxn; 

sts; * 

ds * 6 lit "cosh!*"; 

sto; 

ds «• 16 lit "-argmt ,gt. max "; 

go to figer; 

buff * true; % 

c T n • <jf 

DS * 8 LIT "ALGAMA:*"; 

IF NOT BUFF THEN GO TO NGTV; 



14 



15 



16 
17 



18 



19 

20 



21 

22 



23 



24 



25 
26 



IT "COS!*" 
IT "SIN!*"; 



27 



28 
29 

30 



31 
32 



07907800 
07907900 
07908000 
07908100 
07908200 
07908300 
07908400 
07908500 
07908600 
07908700 
07908800 
07908900 
07909000 
07909100 
07909200 
07909300 
07909400 
07909500 
07909600 
07909700 
07909800 
07909900 
07910000 
07910100 
07910200 
07910300 
07910400 
07910500 
07910600 
07910700 
07910800 
07910900 
07911000 
07911100 
07911200 
07911400 
07911500 
07911600 
07911700 
07911800 
079H900 

07912000 
07912100 
07912200 
07912300 
07912400 
07912500 
07912600 
07912700 
07912800 
07912900 
07913000 
07913100 
07913200 
07913300 
07913400 
07913500 



T 
T 
T 
P 
T 
T 
P 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0380»3 
0383!3 

0384 
0385 
0386 
0387 
0388 
0389 
0389 
0390 
0391 
0392 
0394 
0395 
0396 
0396 
0397 
0398 
0400 
0401 
0402 
0403 
0404 
0405 
0406 
0408 

0408 
0409 
0410 
0411 

0412 
0413 
0416 
0416 
0418 
0419 
0419 

0420 
0421 

0422 

0423 

0426 

0426 

0427 

0429 

0429 

0430 

043 

043 

043 

04 

04 

04 

04 

04 



H 
)?. 
i3 

i34- 
\5 
>38 
»38 
139 



0440 . 
44113 



3 
3 

2 
2 
3 
1 

1 

2 

1 
2 


2 
2 

2 
2 

2 
2 
3 

1 
1 

2 
2 

2 
1 
1 



o 



ARGUMENT "j 



zero: sto; 

ds *■ 16 lit "-zero 

WRAPljP? ^IGER? 

PC[TPARC0JJ.[33»15.Jf34»C0M); 

END forterr; 



07913600 
07913700 

07913800 

07913900 

07914000 



0442*2 
0443*2 

0446 SO 

0446*0 

0447»2 



SIZE* 0448 WORDS 



PROCEDURE MAX> 



% 135 



• 



• 
• 



COMMENT MAX INTRINSIC RETURNING INTEGERS' % PF JULY 67 
BEGIN RFAL X = 'l> RCW = +0* SIZE = +1* JUNK = +2; 
PCO,RCW,FCX# CRCW3 INX NOT INX 0, XCH, SuB» 0* X ) ; 
WHILE (SIZE «■ SIZE " 1 ) > DO 
BEGIN P(DUP); 

JUNK <• *(P(,X) + size); 

if p < junk then p(del>dup); 
end; 

P(1>DIV,RTN); 
END IMA*; 



START OF REL 



08000000 

segment; disk 

08000100 
08000200 
08000300 
08000400 
08000500 
08000600 
08000700 
08000800 
08000900 
08001000 



T 0000*0 
ADDRESS « 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
OQOO'O 
0003*1 
0005*2 
0005*3 
0007*1 

0008' 3 
0009*1 

0010*0 



00553 



PROCEDURE MIW; 



% 136 



COMMENT MIN INTRINSIC RETURNING INTEGERS; % PF JULY 67 
BEGIN REAL X = -1# RCW = +0> SIZE * +1* JUNK « +2; 
PC0»RC&»FCX#CRCW3 INX NOT INX 0* XCH* SuB#0> X 3 ; 
WHILE (SIZE * SIZE - 13 > DO 
BEGIN PfDUPj; 

junk *- *(p(,x) + size); 

if p > junk then p(del*dup); 
end; 
pc1#div,rtn); 

END IMIN* 



size* 0011 words 



08100000 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS = 00554 

08100100 T 0000*0 



• 
• 



08100200 
08100300 
08100400 
08100500 
08100600 
08100700 
08100800 
08100900 
08101000 



0000*0 
0000*0 
0003*1 
0005*2 
0005*3 
0007*1 
0008*3 
0009*1 
0010*0 



size- 0011 words 



PROCEDURE IMOD; 

COMMENT INTEGER MOD INTRINSIC; 

begin integer x = -a» 

V — m 1 " 

pcx mod y#1,0iv*rtn); 

end imod; 



* 137 



* PF JULY 67 



START OF REL 



08200000 

segment; disk 

08200100 
08200200 
08200300 
08200400 
08200500 



T 0000*0 
ADDRESS * 



0000*0 
0000*0 
0000*0 
0000*0 
0001*2 



00555 



SIZE» 0002 WORDS 



PROCEDURE CONCAT ; 



% INTRINSIC NUMBER $140. 



08300000 T 0000*0 



*■ » 



• 



START OF REL SEGMENT* DISK ADDRESS m 00556 

BEGIN % FORTRAN CONCATENATE INTRINSIC: CQNC AT*Y&Z[ A ! 8 ! X 3 , 08300100 T 000Q*0 

REAL Y*-5* Z*-4, ERR=24 J 08300300 T 0000*0 g 

INTEGER A»-3* B = "*2> X«-i ; 08300250 T 0000*0 

DEFINE R= 00055005570267022 #, % NOP,DIA,QPDC Y,0PDC*Z* 08300260 T 0000*0. 

S* ^0055006100650235 # J % NOP,DlB,TRB,RTN f 01300270 T 0000*0 £ 

IF (A*A)<1 OR C8+BX1 OR <X*X)<1 OR (P( 48-X, DUP )<A OR PCXCHXB) 08300300 T 0000*0 

THEN !*CMKS,6,ERR) J 08300400 T 0006*0 

GO PCPCR3&CB DIV 6)[12?45*33&CB MOD 6 ) [ I 5 5 9 t 3 ] , PC S ) , A MOD 6>TRB 3, 08300500 T 0008*1 £ 

P&CA DIV 63U2*45i33&Xt2«S42S63,,B,*,,A,*,[A33 * 08300600 T 0012*3 

END OF CONCAT ; 08300700 T 0016*3 

SIZE* 0019 WORDS £ 



PROCEDURE FCIRTRANMEMHANOLER(A,H)J VALUE HJ REAL H* ARRAY A[*3; X3164 08301000 T 0000*0 
£ START OF REL SEGMENT; DISK ADDRESS a 00557 

BEGIN % H*o => VARYING, H=*6 *> FIXED* H*-l *> RELEASE, 08301100 T 0000*0 

REAL I * 08301200 T 0000*0 

$ PC*A>TQP) * 08301300 T 0000*0 

IF H>0 THEN 08301400 T 000t*l 

IF P THEN PCA4HC3l45l3]»C*2)&(A)C33ll8tl5],*) 08301500 T 0002*0 

# ELSE FOR I«-A. [8*103-1 STEP "1 UNTIL DO PC C AC I 3 3* DUP, LOD> 08301600 T 0006*0 

P&H[3S45*33,XCH,*3 08301700 T 0012*2 

ELSE IF P THEN PC A* 38, COM, DEL 3 08301800 T 00U*0 

6 ELSE FOR I<-A, [8*103-1 STEP -1 UNTIL 00 PC * I A[ 1 3 3 , 38, COM, DEL 3 * 08301900 T 0016*3 

END OF FORTRANMEMHANDlER J 08301950 T 0023*3 

SiZE 3 0025 WORDS 



PROCEDURE SlSQj % 35 08400000 T 0000*0 

START OF REL SEGMENT* DISK ADDRESS » 00558 

# BEGIN 08400200 T 0000*0 

COMMENT STRING ISOLATE. INVOKED AS REALCPTR,N), N COUNTS CHARS,! 08400400 T 0000*0 

DEFINE CSIZE=C31*023** COMMENT CHAR-SIZE FIELD OF PTR; 08400600 T 0000*0 

# EIGHT S 01#* COMMENT VALUE OF CSIZE FOR 8 BITS-CHAR; 08400800 T 0000*0 

INTEGER 08401000 T 0000*0 

SOFF; XBIT OFFSET TO BIT 1 OF S FOR 8-BIT CHAR 08401200 T 0000*0 

# INTEGER 0840140Q T 0000*0 

PTR =-3, 08401600 T 0000*0 

RCW s-2, XSISO IS REALLY A REAL PROC*VALUE IN PTR 08401800 T 0000*0 

# M =-i; 08402000 T 0000*0 

REAL RESULT sPTR* 08402010 T 0000*0 

ARRAY 08402200 T 0000*0 

# STRINGC*3* %UNINDEXED DD FOR SOURCE CHARS 08402400 T 0000*0 

NAME 08402600 T 0000*0 

M=2; 08402800 T 0000*0 

# IF PTRsO THEN PC MKS, INTCALL C C-4 )&1 C2?47 U 3,FQRTERRI 3 > ' 08402900 T 0000*0 

IF PTR, [01*013 THEN 08402925 T 0005*0 

P<MSirUJ47!0l3, PTR. [09 « 22 3 + C PTR . [33*153/03, CHS, CDC>DEL3* 08402950 T 0005*3 

# STRING*M[PTR3; 08403000 T 0010*2 

N + ABSCN),* 08403100 T 0012*0 

IF PTR,CSIZE=EIGHT THEN 08403200 T 0013*0 

# BEGIN 08403400 T 0014*1 





• 



€ 



skip sks sb; 
skip skd db; 
set else ds*1 reset; 

% SAVE IT 



SKIP 1 SB)# 



• 



IF N>6 THEN POL I SH ( ( STRI NG )&6 C 08 J 38 : 10 3 , N# CDC* DEL ) ; 
S0FFf04pTR[32»l8M3]; N*0&N [ 09 J 12 * 36] ; COMMENT BIT INDICES; 

P0LISHC[STRING[CS0FF+N-8) DIV 483]#DEL)J 
STREAMCRESULT«-0:S<-[STRING[SQFF DIV 483 3 » SKS*( S0FF*SOFF MOD 48>> 

SKB*48-N*N');- 

BEGIN 

si«-s; 

di«-loc result; 
ncif sb then ds«-1 
end; 

result :- p(dup); 
end else 

BEGIN 

COMMENT SOURCE HAS 6 BITS/CHAR; 

IF N>8 THEN PQLl SH{ C STRING )&8 I 08 ! 38 *10]# N/CDC* DEL >; 

POLlSH{tSTRlNGt(PTR,[l8*l3]+N-l).t35ll03 3]#DELW 

STREAM(RESULT*OlS«-tSTRIN6tPTR,ClB»10 3n#SKS*PTR.C28l03 3» 

n,Sk6«-8*"N*)J 

BEGIN 

5i*s; 

di«-loc result; 
ds*-n chr; 

enbj 

RESULT s=? P(OUP); 

end; 

if not (pctop)) then 



si+si+sks; 

Dl*DI+SKO* 



% SAVE IT 

% IT IS BAD 
P([RCH]&lC8l38H0]#0f COOIX 



FLAG IT 



end siso; 



08403600 
08403800 

08404000 
08404200 
08404400 
08404600 
08404800 
08405000 
08405200 
08405400 
0S405600 
08405800 
08406000 
08406200 
08406400 
08406600 
08406800 
08407000 
08407200 
08407400 
08407600 
08407800 
08408000 
08408200 
08408400 
08408500 
08408510 
08408600 



0014* 3 

0018*1 

002l«3 
0024*0 

0027*0 
0028*1 
0028*1 
0029*0 
0029*3 
0032*0 
0032*1 
0033*0 
0033*0 
0033»2 
0033*2 
0037*0 
0039*3 
0042*1 
0043*2 
0043*2 
0044*1 
0045*0 

0045*2 
0045*3 
0046*2 
0046*2 
0047*0 
0049*1 



• 



• 



SIZE» 0050 WORDS 



• 



procedure scancupdpdd»ptr,updcdd,hiscount»casecqde,char) 



START OF REL 



value ptr# hiscquwt> 
name updpdd. updcdo; 
integer ptr, 



CASECODE, CHAR; 
HI5C0UNT, CASECOQE, CHAR; 



begin 

COMMENT 



RELATION WHILE UNTIL 

SO 20 

2 4 16 

* 8 12 

? 12 8 

< \6 4 

> 20 

IN ALPHA 24 29 

IN NUMERIC 25 30 

•IN TRUTHSET 26 31 

NOTE: THE TRUTH SET IS THE 64 BITS BEGINNING AT BIT 1 
OF THE WORD POINTED TO BY THE DESCRIPTOR IN CHAR 



NAME M*2; 

ARRAY STRINGOESCC*]; 

INTEGER OURCOUNT* WOFSET* 



CHOFSET* N' Nl» UUNK«l7; 



08410000 

segment; disk 

08410050 
08410100 
08410150 
08410200 
08410250 
08410300 
08410350 
08410400 
08410450 
08410500 
08410550 
08410600 
08410650 
08410660 
08410670 
08410680 
08410690 
08410700 
08410750 
08410800 
08410850 
08410900 



T 0000*0 
ADDRESS 9 






00560 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
C 
C 
C 
C 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

oooo*o 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



• 4 



c 



INTEGER AWHILE; % "IN" SCAN IS FOR WHILE 
BOOLEAN MURE; 
DEFINE PW=[18«103#, 
SiX-00#> 



PC=C28:033#* CSIZE»C31«023»# 

AL0NE*?777777#*PaFSET=C18tl33a; 



• 



SUBROUTI 

BEGIN 

COMME 

STREA 

DO 

BE 

Si 

Dl 

CI 



ne charscan; 
; 

NT SC 

MC|s|> 

KSTR 

GIN 

*dd; 
«-loc 
<-ci+c 



AN FOR C 
CHOFSET, 
iNGDESCt 






GR 

LS 

EQ 

NE 

GE 

LE 

XY 

XX 

SI 

EN 

CHOFS 

*WE 

%OPTI 

WOFSE 

MORE* 

END C 



GO 

GO 

GO 

GO 

GO 

%GO 
1N(IF 
« NC IF 
:N(iF 
*NCIF 
«N(IF 
«N(IF 

STALL 
*N«-TA 

<-ddi; 
d; 

ET«-PO 

NLY N 

MI2E 

T«-POL 

POLlS 

HARSC 



CHAR; 

asecqde; 

o le; 
GE; 
ne; 

EQ} 

US; 
gr; 



ONDITIONS OTHER THAN ALPHA MEMBERSHIP,; 
CHAR * DDl*CSTRINGDESCC033, CASECODE* 
WOFSET33); 

susi+chofset; 

01*01+6; 







TO 



SCSDC 
SC^DC 
SOtDC 
SC*DC 
SC<DC 
SC>DC 

y*i; 
lly; 



HEN 
HEN 
HEN 
HEN 
HEN 
HEN 



«00 
XOl 
102 
%03 
X04 
£05 
JUMP OUT 



JUMP OUT 

jump out 

JUMP OUT 
JUMP OUT 
JUMP OUT 

susin; 
susi-n 

CHOFSET*SU 



TO 
TO 
TO 
TO 
TO 
TO 



xx; 
xx; 
xx; 
xx; 
xx; 
xx ; 



Di«-oi-n; 
di*di*i); 
di*di-d; 
d»di«i>j 

char+si; 



GO 
GO 
GO 
GO 
GO 
GO 



TO 
TO 
TO 
TO 
TO 
TO 



xy; 
xy; 
xy; 
xy; 
xy; 
xy; 



LISHCSUB 
EED [30; 
1 18* 153 

ISH.C33: 

h; 
an; 



^DUP). [18515]; 

033* but rest of field 

TO AN "FTC" OPfRATOR. 

15]; 



IS o and espol knows to 



subroutine alfscan; 
begin; 
comment scan . , . while/until in alpha, numeric* truthsetio; 

STREAM (CH0FSET, SWITCHERj=CASECODE» N : TSETJ'CCHAR]* awhile, 

DDli = CSTRING0ESCC03 3» DD * = [ STRI NGDESC CW0FSET3 ] ) ; 
BEGIN 

sij=dd; siisSi+chofset; 
cijsci+awhile; go ucase; % go wcase; 

WCASE' 

ci:«ci+switcher; go atestw; go ntestw; % go ttestw; 
ttestw: di»=loc switcher; 

N C DDSrSI; DIlsDl-i; DSJbCHR; 

sis=tset; skip chofset sb; skip sb; 
if sb then; su=dd; 

if toggle then sussi + i else jump out to tstopw; 
); 
go awayw; 

NTESTWS 

N C IF SC GEQ "0" THEN IF SC LEQ "9» THEN; 

IF T0GGLE THEN SIIbSI+1 else JUMP OUT to tstopw; 



08410925 
08410950 

08411000 
08411050 

osailioo 

08411150 
08411200 
08411250 
08411300 
08411350 
08411400 
08411450 
08411500 
08411550 
08411600 
08411650 
08411700 
08411750 
08411800 
08411850 
08411900 
084H950 
08412000 
08412050 
08412100 
08412150 
08412200 
08412250 
08412300 
08412350 
08412400 
08412450 
084J2500 
08412550 
08412600 
08412650 
08412700 
08412750 
08412800 
08412850 
08412900 
08412950 
08413000 
08413010 
08413020 
08413030 
08413040 
08413050 
08413060 
08413070 
08413080 
08413090 
08413100 
08413110 
08413120 
08413130 
08413140 



C 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
P 
P 
P 
C 
C 
C 
C 

P 

C 

C 

c 
c 
p 
c 
c 
c 
c 



oooo«o 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

ooono 
oooiio 
ooono 

000310 
0003*3 
0003 I 3 
OOO4J2 
0005*0 
0005*2 
0005*3 
0006*0 
0006*1 
0006*2 
0006*3 
0006*3 
0009*0 
0011H 
0013*2 
0015*3 
0018*0 
0020*1 
0020*3 
002112 
0022*0 
0022*1 
0024*0 
0024*0 
0024*0 
0025*0 
0025*2 
0025*3 
0025*3 
0026*0 
0026*0 
0026*0 
0027*3 
0029*0 
0029*0 
0029*3 
0030*2 
0030*2 
0031*2 
0031 13 
0033*0 
0034*0 
0034*3 
0036*0 
0036*1 
0036*2 
0036*2 
0038*0 



c 



• 



# 



); 

GO AWAYW; 
ATESTW! 

N ( IF S0=AlPHA THEN SIfaSI+1 ELSE JUMP OUT TO TSTOPW ); 
AWAYWI 

TALLYlsi; 
TSTOPW? GO TO DONE; 
UCASEt 

Cliad + SWITCHER; GO ATESTU; GO NTESTUJ % GO TTeSTU; 
TTESTU: DI$=LOC SWITCHER; 

N ( DDtcSIj 01 :=0I -1; dss=chr; 

sij=tsetj skip chofset sb; skip sb; 

if sb then; sij»dd; 

if toggle then jump out to tstopu; suwsi + i; 

)} 

GO AWAYU; 
NTESTU: 

N ( IF SC GEQ "0" THEN IF SC LEQ "9" THEN JUMP OUT TO TSTOPU; 

si jasi+i; 
); 

GO AWAYU; 
ATESTU* 

N C IF SC=ALPHA THEN JUMP OUT TO TSTOPUi SI t»SI + l U 
AWAYU: 

TALLYtci; 
TSTQPU* DONE? 

N!=TALLY; SWITCHER»«Si; Si t*DDl J CHQFSET **$I ; 

end; 
more*polish; 

CHOFSET«-POLlSHfSUB»DUP).Cl6*l53J%OPTlMIZEO C 30 J033 ISOLATE. 

wofset^-polish. [335153; 
end alfscan; 

IF PTR*0 THEN P(MKSfINTCALt((-«)4U2U7li]#P0RTERRI)) * 
IF PTR.C&H01J THEN 

P(M8,.lCia:47SOi]fPTR,[09:223 + (PTR,C33S153XO),CHSfCOC»DEL); 
IF PTR.CSIZE^SIX THEN POL ISHCM& 1 C 14 S 47 I 1 3 * 8686* CDC* DEL >* 

STP?TNrnrSr*.MrPTR] * 

IF C0URC0UNT«-0S(STRINGDESCH35J08!103-PTR.P0FSET) <0 THEN 

P0LlSH(CSTRIiMGDESC[PTR,P0FSET3 3); 
IF HISCOUNT S THEN 

begin updcod[q3«-0;updpddcc3«-ptr + 0&wofsetu8j35!13 3;pcxm;end; 
if (hisc0umt < -cjunk<-hisc0unt).c33:15])<0urc0unt then 

ourcount*-hiscount; 
wofset«-ptr.pw; chgfset*ptr,pc; 

n*ni«-ourcount; more*true> 

if casecooe geq 24 then % in alpha* numeric* truthset 

BEGIN 

IF AWHIl_E: = CCASECODE LEQ 26) THEN % CONDITION IS "WHILE IN" 

ELSE CASECODEIsCASECODE-U % CONDITION IS "UNTIL IN" 

CASEC0DE?sCASEC0DE,t46S23; % 0*1,2 

IF Nt>63 THEN 

BEGIN 

N«-63; 

DO ALFSCAN UNTIL CNK-N1-63 )S63 OR NOT MORE; 

n*ni; 

end; 



08413150 


P 


0039*1 


08413160 


C 


0039*2 


08413170 


c 


0039*3 


08413180 


c 


0039*3 


08413190 


c 


0042*0 


08413200 


p 


0042*0 


08413210 


c 


0042*1 


08413220 


c 


0042*2 


08413230 


c 


0042*2 


08413240 


c 


0043*2 


08413250 


p 


0043*3 


08413260 


c 


0045*0 


08413270 


c 


0046*0 


08413280 


c 


0046*3 


08413290 


c 


0047*3 


08413300 


p 


0048*0 


08413310 


c 


0048* 1 


08413320 


c 


0048*1 


08413330 


c 


0050*1 


08413340 


c 


0050*2 


08413350 


p 


0050*3 


08413360 


c 


0051*0 


06413370 


c 


0051*0 


08413380 


c 


0053*0 


08413390 


c 


0053*0 


08413400 


p 


0053*1 


08413410 


c 


0053*1 


08413500 


T 


005**1 


08413550 


T 


0054*2 


08413600 


T 


0055*0 


08413650 


T 


0056*3 


08413700 


T 


0057*3 


08413750 


T 


0058*0 


08413755 


T 


0058*0 


08413760 


T 


0064*2 


08413770 


T 


0065*1 


08413800 


T 


0070*0 


08413850 


T 


0073*3 


08413900 


T 


0075*1 


08413950 


T 


0078*3 


08413960 


T 


0080*1 


08413970 


T 


0081*0 


08414000 


T 


0084*3 


08414050 


T 


0087*0 


08414100 


T 


0088*1 


08414200 


T 


0090*3 


08414250 


P 


0092*3 


08414300 


T 


0093*2 


08414350 


P 


0094*0 


01414360 


C 


0095*1 


08414370 


c 


0099*1 


08414400 


T 


0100*2 


08414450 


T 


oiom 


08414500 


T 


0101*3 


08414550 


T 


0102*2 


08414600 


T 


0107*0 


08414650 


T 


0107*3 



i 

i 
i 

1 



* * 



• ■» 



IF 



IF 



END 



IF N 

END 

BEGI 

CASE 

IF N 

B 

N 



N 

E 

IF N 

end; 

HlSC 
POLI 
POLI 
BEGI 
WOFS 
UPDC 
UPDP 

end; 

SCA 



>0 AND MORE THEN ALFSCAN; 

ELSE 

N 

C0DE«-CASECQDE,U3!33; CHAR * sO&eHARC 36 8 42 * 6] ; 

1>63 THEN 

E&IN 

«-63; 

CHARSCAN UNTIL (Nl*Nl-63)S63 OR NOT MORE; 

<-Nl; 

nd; 

>0 and more then charscan/* 

ount>ourcount and more then 

sh{[str i ng0esc[chofset&wafsett3o 133 115333 )j 

shc.upopd0,lqd*rfb*.updcdd*lod*rfb*ar)*o then 

N 

ET*CH0FSET&W0FSETC30! 33! 153-pTR, £185 1331 

DDCOI «-hiscount-wofset; 

0DC0 3*PTR+0*W0FSETC18«35I133; 

n; 



08414700 
08414750 
08414800 
08414825 
08414850 
08414900 
08414950 
08415000 
08415050 
08415100 
08415150 
08415200 
08415250 
08415300 
08415350 
08415400 
08415450 
08415500 
08415550 
08415600 
08415650 



SIZE* 



107*3 
111*0 

111*0 
111*2 
114*2 
115*1 
115*3 
116*2 
121*0 
121*3 
121*3 
125*0 
125*0 
126*1 
128 * t 
130*2 
131*0 
133*3 
135*0 
137*1 
137*1 
Oi38 






WORDS 



PROCEDURE REPL* 



START OF REL 



BEGIN 

COMMENT STR 

MARCH 1968. 

8-BTT CHARS 

DEFINE 

CSIZE=C3 
DECNVRT= 
AMPER^Cl 
POTZ-IF 

ARRAY 

S0RCt*3 
0ESTC*3 

NAME 

UPDPDD 
UPSPDD 
UPCTDD 
M 

INTEGER 
DPTR 
SPTR 

HISCNT 
RELATION 



ING REPLACE INTRINSIC FOR 85500 TS ALGOL 

RATCHFORD 
, WORD XFERS & UNCONDITIONAL XFER ADDED APRIL 1968 HjR; 

l«023*# EIGHT*01#» TC0NDs45#* DOT = 1 1 8 * 13 3 *, 
C'32 )#* 

8*35*133*' 

SB THEN DSfl SET ELSE 0S*1 RESET; SKIP 1 SB;#; 

» COMMENT OESC FOR SOURCE STRING; 

/ COMMENT DATA OESC FOR DESTINATION STRING; 

=-08* COMMENT OESC FOR UPDATE DEST POINTER; 
*-06* COMMENT OESC FoR UPDATE SOURCE POINTER; 
a-04» COMMENT DESC FOR UPDATE COUNT VARIABLE; 

* 02; 



CHAR 
CHAR1 



= "07* COMMENT DESTINATION 
5-05* COMMENT SOURCE POINT 
8 ONLY IF LITERAL IS 
="03* COMMENT CALLER»S IOE 
= "02* COMMENT SWITCH INDEX 
VALUES ARE SUPPOSED 
AND SCAN. RELATION 
A LITERAL AND IS JO 
COMMENT COMPARE USES 
"-01* COMMENT THE WHILE/UN 
* COMMENT SDA*FORMAT 



pointer; 

er or 1 to 8 literal chrs, 

arithmetic; 
a of how big maxcount is} 

for scan code, the index 
to be the same for repl 
IS <0 IF the source is 
if source is a pointer; 

the same values of relat; 
til comparison char; 
addr of 1st xferred char; 



08420000 

segment; DISK 

08420020 
08420040 
08420060 
08420080 
08420100 
08420120 
08420130 
08420140 
08420160 
08420180 
08420200 
08420220 
08420240 
08420260 
08420280 
08420300 
08420320 
08420340 
08420360 
08420380 
08420400 
08420420 
08420440 
08420460 
08420480 
08420500 
08420520 
08420540 
08420560 



T 0000*0 
ADDRESS « 



00565 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

oooo'o 

0000*0 
0000*0 
0000*0 
0000*0 

ooooto 

0000*0 
0000*0 
0000*0 



€ 



CHARM 

SORCL 

DESTL 

SWIsCHARl* 

OURCNT 



• 



SOFF 

SSIZE 

DOFF 

DSIZE 

UPDTOG 

JUNK 

TOGL 

REFETCH 

INITIAL 
INTFGER AWHILE* 
BOOLEAN MORE* 



* COMMENT SDA FORMAT AODR OF LAST 
sCHARl, COMMENT LENGTH OF SOURCE CALCUL 
=CHARN*COMMENT REMAINING CHARS IN DEST 
OWlsCHARN* ITERC* 

> COMMENT SAFE MaX LENGTH FOR REPL 
FOR POINTER-SOURCE' MI'NCMISCNT*S 
FOR LITERAL SOURCE* MINCDESTL*HI 
COMMENT CHARACTER OFFSET IN SOUR 
SOURCE CHAR SIZE (6 OR 8 
CHARACTER OFFSET IN DEST 
DEST CHAR SIZE; 
TRUE IF ANY UPDATE(S) RE 
USED FOR BUILDING CONCAT 
"TOGGLF" FOR REPLACE WHI 
THE "INVALIDATOR" FOR RE 
LOCAL 4 USE BY REPL FROM 
IS "WHILE IN" 



=SOFF*COMMENT 
r COMMENT 

=DOFF*COMMENT 
> COMMENT 

=17* COMMENT 
* COMMENT 

=TOGL*COMMENT 

sTOGL/COMMENT 
% CONDITION 



xferred char; 
ated by us; 

string; 

ACE t 

orcl*destu# 
scnt); 
ce; 

bits/char); 
ination; 

quested; 

ENATED LITRL; 

le/until; 

pl until; 

literal; 



^CONDITIONAL REPLACE ISN»T DONE YET' 



FOR POINTER 
OESC FOR DE 



• 



ARRAY NAME 

SORCI =SQRC>COMMENT INDEXED DESC 

qesti =dest;comment INDEXED DATA 
subroutine crepl; 
begin; 
stream ( oqff/ char*soff* i terc* moreno i 

Dl*tDESTC0]].SUtS0RCCOn*RELATION*T*O#S2*CS0RC 

Q2*CDESTCDWin)J 

BEGIN 

OI*OI+DOFFi D2«-Di; DI*LOC CHAR) 

di^di+6; t*ou si«>s2; 

si«-si+soff; 

iterccci«-ci+relation; 

go to le; 

go to ge; 



-source; 
st string; 



[SWI33. 



GO 
GO 
GO 
%GO 



TO 
TO 
TO 
TO 



ne; 
eq; 
ls; 
gr; 



• 
# 



xx; 
XX; 
xx; 

XX; 
XX; 
xx; 

TO 



grsif scsoc then; go to 

lssif scsdc then; go to 

eqjif sc*dc then; go to 

ne*if scsdc then; go to 

gejif sc<dc then; go to 

LE'IF sc>dc then; *go to 

xx? if toggle then jump out 

si*si-ij 01*02; 

02*0 i; di*t; 

tally*i; si*si+i; 

xysmore«-tally; si*si-i; 

si«-si; doff«-si; 

iterc<-di; di*oi; 
end; 

more*polish; 

doff*pol ishc sub* dup). tie tisi; 

DWI*POLlSH,C33llbl; 
SOFF«-f»OLlSHCSUB#DUP),C 181151; 
SWl<-PflLlSH.C33H53j 



XY, 



ds*chr; 



char*si; 

01*021 

sqff*di; 



%OPTIMIZED C 301033 ISOLATE, 



08420580 
08420600 
08420620 
08420630 
08420640 
08420660 
08420680 
08420700 
08420720 
08420740 
08420760 
08420780 
08420800 
08420820 
08420840 
08420860 
08420865 
08420870 
08420880 
08420900 
08420920 
08420921 
08420922 
08420923 
08420924 
08420925 
08420926 
08420927 
08420928 
08420929 
08420930 
08420931 
08420932 
08420933 
08420934 

08420935 
08420936 
08420937 
08420938 
08420939 
08420940 
08420941 
08420942 
08420943 
08420944 
08420945 
08420946 
08420947 
08420948 
08420949 
08420950 
00420951 
08420952 
08420953 
08420954 
08420955 
08420956 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

C 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0001*0 

0001*0 

0002*2 

0004*3 

0005*2 

0005*2 

0006*2 

0007*1 

0007*3 

0008*3 

0009*0 

0009*1 

0009*2 

0009*3 
0010*0 
0010*0 
0010*3 
0011*2 
0012*1 
0013*0 
0013*3 
001411 
0015*0 
0015*3 
0016*1 
0016*2 
0017*0 
0017*3 
0018*2 
0019*1 
0019*2 
0020*0 
0021*3 
0022*3 
0024*2 



# 



« ♦ 






TTESTWt 
N f 



END CONDITIONAL REPLACE* 
SUBROUTINE C«AJ 

BEGIN) COMMENT REPLACE . ^HlLE/UNTlL IN ALPHA* NUMERIC, TRUTHSET; 
STREAMCnQFF, Ti:«0* SQFF. N!=IT£RC> MPRe**0 J TSET !* C CHAR3 * AWHILE* 

OUsCDESTCCm* sn»csoRccon# relation, 

S2I3ESORCCSWI]]* D2?=CDESTEDWI3 3); 
BEGIN 

DltaDI+OOFF; sn*S2; SI:sSI+50FF; 
CIlaCI+AWHILE) GO UCASE; % GO WCASE; 
WCASE*. 

CIlnCl+RELATIONI GO ATESTW; GO NTEST^; % GO TTESTW; 
D2*=DI; DI5*LOC Tlj DI**Dl-i; Tl t«DIl DI**D2; 
D2*=DU S2i=Si; Dl»*Ti; DSs*CHR; 
SlJrTSET; SKIP DOFF Sb; SKIP SB; 
IF SB THEN* Sls=S2* DI»aD2J 

IF TOGGLE THEN QS$=CHR EUSE JUMP OUT TO TSTOPWJ 
)l 
GO AWAYw; 
NTESTWJ 

N ( IF SC GEO "0" THEN IF SC LEQ "9" THEN; 

IF TOGGLE THEN QS:=CHR ELSE JUMP OUT TO TSTOPW* 

); 

GO AWAYW; 
ATESTW! 

N C IF SC=ALPHA THEN DSjsCHR ELSE JUMP OUT TO TSTOPW )i 
AwAYWt 

tally»*i; 
tstopw! go to done* 

UCASE: 

ci!=ci+relation; go atestu; go ntestu; % go ttestu; 

TTESTU* D2laOI) QI*»10C Ti; OIl«Ol-li Tl*=Di; DI*=D2; 
N C D2taDI* S2: =»Si ; OII.TW DSSsCHR; 

si:=tset; skip doff sb; skip sb; 

if sb then; Sis=S2; DP-D2;; 
if toggle then jump out to tstopu; ds?=chr; 
>; 
go awayu; 

NTESTU! 

n ( if sc geq "0" then if sc leq "9" then jump out to tst.opuj 
dsjschr; 
); 
GO awayu; 
atestu* 

n ( if sc = alpha then jump out to tstoptj; dsi=chr )) 

AWAYU » 

TALLYSst; 
TSTOPU! DONE! 

wore!=tally; ni = si; tiisdi; siissi; soffj»si; o i »=d i; oqffudij 
end; 

more!=p; s0ff! = p(su8*dup).c18:i5]; swi j=p,e33!153; 

DOFF » «P ( SUB. DUPJ.C 18115]; DW 1 8 *P , [ 33 i 15 3 ; 
END C9NDITI0NAL ALPHA REPLACE; 
IF DPTR,C0l!01] THEN 

PCM&lC14Jfl7IOn,DPTR,[09i22]+(DPTR«t33«15 3/0)*CHS»COC#DEL)J 

IF CSPTR = AND REL ATION , C 1 * 1 3sO ) OR DPTR'O 

THEN P(MKS*INTCALL(C-4)«U2M7H]#F0RTERRI)J ; 

DEST!»MCDPTR3; 



08420957 
08420958 
08420959 
08420960 
08420961 
08420962 
08420963 
08420964 
08420965 
08420966 
08420967 
08420968 
08420969 
08420970 
08420971 
08420972 
08420973 
08420974 
08420975 
08420976 
08420977 

08420978 
08420979 
08420980 
08420981 
08420982 
01420983 
08420984 
08420985 
08420986 
08420987 
08420988 
08420989 
08420990 
08420991 
08420992 
08420993 
08420994 
08420995 
08420996 
08420997 

08420998 
08420999 
08421000 
08421001 
08421002 
08421003 
08421004 
08421005 
08421006 
08421007 
08421008 
08421009 
08421010 
08421011 
08421012 
08421013 



T 
T 
P 
P 
P 
P 
P 
P 
P 

P 
P 
P 

P 
P 
P 
P 

P 
P 
P 
P 
P 
P 
P 
P 
P 
P 
P 
P 
P 
C 
C 

c 
c 
p 
c 
c 
c 
c 
p 
c 
c 
c 
c 
p 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 



0025*2 

0025*3 

0026*0 

0026*0 

0028*1 

0029*2 

0030*3 

0030*3 

0032*0 

00 32*3 

0032*3 

0033*3 

0035*0 

0036*2 

0037*2 

0038*2 

0039*3 

0040*0 

0040*1 

0040*1 

004i*3 

0043*0 

0043*1 

0043*2 

0043*2 

0045*3 

0045*3 

0046*0 

0046*1 

0046*1 

0047*1 

0048*2 

0050*0 

0051*0 

0052*0 

0053*0 

0053*1 

0053*2 

0053*2 

0055*2 

0055*3 

0056*0 

0056*1 

0056*1 

0058*1 

0058*1 

0058*2 

0058*2 

0060*1 

0060*2 

0063*3 

0066*2 

0066*3 
0070*3 
0075*2 
0078*0 
0082*2 



c 






0SIZE5? 

IF (TOG 

SSIZ 

ELSE 

IF TOGL 

POLI 

UP0TOG* 

POLI 

IF (HIS 

BEGIN 

IF DSIZ 

BEGI 

$ SET OMIT 

COMMENT CAU 

PQ 

S RESET OM 

END 

COMM 

S 

IF R 
8 
C 

I 



IF DPTR.CSIZE^EIGHT THEN 8 ELSE 6} 

L?=RELATlON,r.Oi:Oi3-Q) THEN 

E»»IF SPTR.CSIZEsEISHT THEN 8 ELSE 6 

SSIZE«-6J COMMENT LITERAL OR AEXP SOURCE; 

AND DSI2E/SSIZE THEN 
SH(DEST41t08»38U0]*8686»C0C,DEL); 

sh(.updpdd,lod,rfr*.upspdd,lod*rfb#qri.upctdd#lod*rfb#or)*oj 
cnt«-hiscnt) < then 

upctddcouo;updpdoco3«.dptr;upspddcoj*sptr;p<xit)jendj 

E=8 THEN 
N 

s NOT EIGHTBIT 
SE INVALID INDEX* 9898 GEQ AsZ IF 8 BIT REPLACE IS DONE* 
LISH(DEST*1[8»38M0]#9898*CDC»DEL); 
IT 

ELSE %8-BlT DEST FINISHED 

ENT IF WE GET THIS FAR, DSIZE/EIGHT & SSIZE=DSIZE* SQ 

PTR CAN"T BE 8 bits/char; 

ELATION, C42!Q6]sTCaND THEN 

EGIN 

OMMENT UNCONDITIONAL XFER OF 6-BIT CHARS OR WORDS; 

F RELATION. [4'OJOlJ-l THEN 

BEGIN 

COMMENT WORD TRANSFER; 

DPTR.D0T«.C&(D0FF*C0&DPTRC35*18lt3] + 7>.C35tl0j)[35l3 8110]J 

OURCNT«-HlSCNT,C38!l03; 

IF CDOFF + aURCNT)>(DE.ST), [08110] THEN 

POLlSHC[DESTt(DEST.[8J103)]3); 
IF TOGL THEN 
BEGIN 
IF SBTR»tOUOl3 THEN 

P(M41C14U7I013#SPTR.C09I22]+(SPTR.C33I15]XO)*CHS» 
CDC, DEL); 
COMMENT POINTER SOURCE; 
SORC*MtSPTR]l 
SPTR,DOT«.0S.(SOFF*f0SSPTR[35«18»133+7),[35JlO3)[35S38SlO3; 
IF (SOFF+OURCNT)>CSORC).C08I10] THEN 
POLISHCCSORCCCSORC. [81 103)33); 
IF OURCNT>0 THEN 
STREAM ( SOURCE* CSORCCSOFf] 3* 

Nl*0URCNT#N2*0URCNt, [38104], 

DESTAD<-[DEST£DOFF33); 

BEGIN 

si«-source; 

qs«-n1 wds; n2c2cds«-32 wds)); 
end; 
end else x6-bit pointer source finished for wd xfer 

BEGIN 

COMMENT LITERAL/AEXP SOURCE* 

SQRCL>HISCNT.[18U5]; 

IF SORCL=0 THEN SORCL*HlSCNT; 

INITIA1.*-IF QURCNT>0 THEN 1 ELSE 01 

OUUCNT«-aURCNT«INlTIAL; 

STREAM (START*SPTR,SORCL, INITIAL* 

S0FSET*8-S0RCL»IN1*(JUNK*8 DIV SORCL), 
IN2«-8-JUNKxS0RCL*Nl«-0URCNT,N2«-0URCNT,[38SO4 3* 



08421014 
08421015 
08421016 
08421020 
08421040 
08421060 

08421080 
08421100 
08421120 
08421130 
08421140 
08421160 
08421170 
08423273 
08423275 
08423276 
08423280 
08423300 
08423320 
08423340 
08423360 
08423380 
08423400 
08423420 
08423440 
08423460 
08423480 
08423500 
08423520 
08423540 
08423560 
08423570 
08423571 

08423572 
08423580 
08423600 
08423620 
08423640 
08423660 
08423670 
08423680 
08423700 
08423720 
08423740 
08423760 
08423780 
08423800 
08423820 
08423840 
08423860 
08423880 
08423900 
08423920 
08423940 
08423960 
08423980 
08424000 



C 
C 

c 

T 
T 
T 

T 

T 
P 
T 
T 
T 

C 
C 

c 
c 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



008410 
0087M 
0089*0 
0092*0 
0094*0 
0095*1 
0098*0 
0098*0 
010153 
0103*0 
0106*0 
0106»3 
0107* 1 
0107*1 
03.07*1 
0109*2 
0109*2 
0109*2 
0109*2 
0109*2 
0113*1 
0113*3 
0113*3 
0115*0 
0115*2 
0115*2 
0120*3 
0122*0 
012«!0 
0125*3 
0126*0 
0126*2 
0127*1 

0131*2 
0132*0 
0132*0 
0133*2 
0138*3 
0140*3 
0142*2 

0143*1 
0144*2 
0145*2 
0146*1 
0146*1 
0146*2 
0148*2 
0148*3 
0148*3 
0149*1 
0149*1 
0150*2 
0152*2 
0155*1 
0156*2 
0157*2 
0159*2 



€ 

i 

i 
i 
i 
i 
t 



* « 



c 

• 



SI*SI*S0FSETI 

SI«-SOFSET)) 
DI*DESTAD) 

Sl*STARTi 



• 
• 



• 



DESTAD«-r.DEST[00FF]]^ 

3ETDI*[JUNK3)) 

BEGIN 

si«-luc start/ 
sqfset*sd 

ini(ds*.sorcl chr; 
ds<-jn2 chri susetdi; 

STARTED!) 
DSi-INlTlAL WDSJ 

ds*n1 wds) n2c2c0s<-32 wds)}) 

end; 
ouRcnt«-ourcnt+initiad 
end;*of word-xfer from lit-aexp source 
if updt06 then char*0«;ourcnt e 32 ! 35 * 1 33 ) 
end else %vi0r0 transfer done 

BEGIN 

COMMENT CHAR XFER FROM 6-BlT SOURCES) 
DOFF«-DPTR.DOT) OURCNT«-HiSCNT.[35*13 3) 
IF CDnFF+0URCNT)>0*tDEST)t35i08il0] THEN 

POLlSH(CDEST[(DEST.[8:io3)3 3)i 
IF TOGL THEN 
BEGIN 

COMMENT SOURCE IS A POINTER) 
IF SPTR.COl SOI 3 THEN 

P(M41[l4:a7l013#SPTR.C09l22]+(SPTR,[33li53#0)*CHS# 

CDC, DEL)) 
SQRC«-M[SPTR]J 

SOFF*OSSPTR[35Sl8:i33) 
IF (SOFF + OURCNT) > S ( SQRC ) C 35 J 8 J 103 THEN 
BEGIN 

INITIAL * = HISCNT. [35*133 - HISCNT . [20 *1 3 3 ) 
STRE AM (START 8 ==5PTR. [28*33* F IN ISH« sDPTR , [28 J 33* 
Nli-*INITIAU* N2?=INITIAL,E37*53* 
N3:alNITIAL.[35l2], INITIALS' Hi ScNT , [ 20 II 33 * 
iNlla HISCNT. [22153* IN2* = HlScNT , [ 20 J 23 » 
SOURCE" [SORCCSPTR, [18»l0333* 
DESTAQS= [OESTtDPTR.ClSJ 103333) 
BEGIN 
SlSsSOURCE) SlisSI+START) DI JsOI+FlNlSH) 

SOURCE* 55 DD 

DS?s INITIAL CHR) lNl(2<DS*s32 CHR ))) 

IN2C2C32CDSI* 32 CHR )))) 

SI ** SOURCE) 

DSsb Nl CHR) N2C2(DSS* 32 CHR ))) 
N3f2(32(DSS= 32 CHR 3))) 
END) 



END ELSE 



IF OURCNT>0 THEN 

STREAMC START«-SPTR,[ 28*03 3 *FINISH«-DPTR, [28*03 3* 

Nl«-0LRCNT*N2«-0URCNT,E37*05 3*N3*aURCNT,E35*02 3* 
S0URCE<-CS0RCCSPTR.C18U03 3 3# 
DESTAO«-[DEST[DPTR.[18»103 3 3)) 
BEGIN 
SHSOURCE) si*si*start; 
OUDI + FINISH) 

DS«-N1 CHR) N2(2(DS«-32 CHR))) 
N3C2C32CDS*32 CHR)))) 



08424020 
08424040 
08*24060 
08*24080 
08424100 

08424120 
08424140 
08424160 
08424180 
08424200 
08424220 
08424240 
08424260 
08*24280 
08*24300 
08424320 
08424340 
0842*360 
08424380 
08424400 
08424420 
08424440 
08424460 
08*24470 
08*2*471 
08424472 
08424480 
08424500 
08*24503 
08424504 
08424506 
08424508 
08424510 
08424511 
08424512 
08424513 
08424514 
08424516 
08*24518 
08424520 
08424522 
08424524 
08424526 

08424530 
08424540 
08424544 
084245*6 
08424550 
08*24560 
08*24580 
08424600 
08*24620 
08*2*640 
08424660 
08*2*680 
08*24700 
08424720 



0161*3 
0162* 1 

0162*3 
0162*3 

0163*2 

0163»3 
0165«1 
0166*1 
0166*2 
0167*1 
0169*1 
0169*2 
0170*3 
0170*3 
0173*1 
0173*1 

0173*3 
0173*3 
0176*1 
0178*3 
0180*2 
0180*3 
0181*1 
0181*1 
0182*0 
0186*1 
0186 ! 3 
0188*1 
0190*0 
0192*2 
0193*0 
0195*1 
0197*0 
0198*0 
0199*2 
020i*0 
0202*0 
0203*1 
0203*1 
020**2 
020**3 
0206*3 
0208*3 
0209*0 
0211*0 

0213*0 
0213*1 
0213*1 
0214*2 
0216*3 

0218*2 
0219*2 

0220*3 
0220*3 
0221*2 
0222*0 
0224*0 



• 
• 
• 

• 



CI 



c 






• 



IF 



EN 
END E 

RELATION 

BEGIN 

DOFF*DPT 

IF CHISC 
PQLIS 

IF CO 
POLIS 

SPTR*-SPT 
BEGIN 
DI* 
DS*HI 

end; 

CHAR*-HIS 
END ELSE 
BEGIN 
COMMENT 
IF SPTR, 
PC Mil 
SORC*M[S 
SORCL*0& 

destl*o& 

OURCNT*-! 



end; 
end els 

BEGIN 

COMMENT 

SQRCLoH 

IF SORC 

INITIAL 

QURCNT* 

IF INIT 

IF INIT 

STRF. 

D 

8 

n 
s 

E 

STREAMC 

SOFS 

IN2* 

n3«-o 

DEST 
BEGI 

SI*L 

SOFS 

0S4-I 

DUD 
DS*I 

DS«-N 
N3(2 

end; 

OURCNT* 

end;*of 

CHAR*OU 
% OF 6 

LSE% unc 
aDECNVRT 



E %POINTER SOURCE FINISHED 



LITERAL/A 

ISCNT.HS! 
L=0 THEN S 
♦IF OURCNT 
OURCNT-INI 
IAL>0 THEN 
IAL<SORCL 
AMCINITIAL 
OFSET*DPTR 
EGIN 

i*di+dofse 
i«-si+sskp; 

ND ELSE 

START*SPTR 
ET*8-S0RCL 
8-JUNKxSOR 
URCNT,C35« 
AD«-[DEST[0 
N 

oc start; 
et*si; in 
N2 CHR; SI 

i+dofset; 
nitial chr 
l chr; N2 

(32CDS*32 



exp source* uncond xfer* 6-bit dest* 

qrcl*hiscnt; 

>7 then 8 else ourcnt; 

tial; 

THEN 

,SPTR*SSKP* 8-SQRCL* 

.C28i03 3»0«-CDESTtDPTR,C18*iOJn)l 



t; 



si*loc sptr; 
dsmnitial chr; 




1CDS«-SgRCL 
*SETDI ; 



chr; 



; 

C2CDS*32 
CHR))); 



si*si+sqfset; 

si*sofseT); 
di*destad; 
start*di; 
si*start; 



CHR)); 



ourcnt+initial; 
literal/aexp 6-bit source 
rcnt; 

-bit unconditional xfer 
onditional xfer finished 

THEN 



H. [281033* DWI*DPTR,[18?103; 
NT* (JUNK* HISCNT),[33J153)>8 THEN 

H(M&8C08»38U0]»HISCNT*C0C*DEU); 

&CDEST) C35!08I103»DPTR.DOT)«»HISCNT<0 THEN 

HCtDESTCDPTR,DOT+HISCNT]]*OEL); 

R; STREAMCSPTR»DOFF»HIScNT#0*tDESTCDWl3 3>; 



i + doff; 
scnt dec; 

cnt; 



si* loc sptr; 



CONDITIONAL XFER W/ SOURCE ft DEST BOTH 6-BIT POINTERS; 

COHOlJ THEN 

C 14 : 47 : 01 3, SPTR. [09 $ 221 + (SPTR. [ 33 » 153*0), CHS, CDC* DEL); 

PTR3; 

CS0RO[35!08J10]-SPTR.D0t; 

(DEST)C35»08«103-DPTR t DOT; 

F SORCL>DESTL THEN 



08424740 


T 


0226 


10 


08424760 


T 


0226 


11 


08424780 


T 


0226 


n 


08424800 


T 


0226 


83 


08424820 


T 


0226 


«3 


08424840 


T 


0228 


10 


08424860 


T 


0230 


10 


08424880 


T 


0232 


!3 


08424885 


T 


0234 


10 


08424890 


T 


0234 


13 


08424891 


T 


0236 


10 


08424892 


T 


0238 


10 


08424893 


T 


0240 


«0 


08424894 


T 


0240 


to 


0842*895 


T 


0240 


!3 


08424896 


T 


0241 


13 


08424900 


T 


0242' 





08424920 


T 


0243 


12 


08424940 


T 


0245 


12 


08424960 


T 


0247! 


3 


08424980 


T 


0249! 


1 


08425000 


T 


0250 


! 3 


08425020 


T 


0250 


13 


08425040 


T 


02511 


2 


08425060 


T 


0253 


1 


08425080 


T 


0254 


«1 


08425100 


T 


0255! 





08425120 


T 


0255 


3 


08425140 


T 


0257! 


3 


08425160 


T 


0259! 


3 


08425180 


T 


0260! 





08425200 


T 


0261! 


1 


08425220 


T 


0261! 


1 


08425240 


T 


0262! 





08425260 


T 


0262! 





08425264 


T 


0262' 


10 


08425265 


T 


0263' 


2 


08425266 


T 


0264! 





08425267 


T 


0266! 


2 


08425268 


T 


0268! 


3 


08425269 


T 


02711 


1 


08425270 


T 


02741 


3 


08425271 


T 


0277! 





08425272 


T 


0279 


2 


08425273 


T 


0279! 


>2 


08425274 


T 


0280 


n 


08425275 


T 


0280! 


»3 


08425276 


T 


0281! 





08425277 


T 


0281! 


3 


08425280 


T 


0281! 


3 


08425300 


T 


0282! 


1 


08425312 


T 


0282! 


1 


08425314 


T 


0283! 





08425320 


T 


02871 


3 


08425340 


T 


0289! 


1 


08425360 


T 


029 2 ! 


1 


08425380 


T 


0295' 


1 



• 



• 



• 



» I 



€ 






(IF HISCNT>DESTL THEN DESTL ELSE HISCNT) ELSE 
IF HISCNT>SQRCL THEN SORCL ELSE HISCNT; 



DOFF«-DPTR f [28*033; 
DWi*DPTR.C18»10]; 



or not more; 



• 

• 



SOFF*SPTR. C285033; 
SWl«-SPTR.tl8»l0i; 

MORE*TRUEJ 

IF RELATION GEO 24 THEN * IN ALPHA, NUMERIC* TRUTHSET 

rt p- A t * . 

IF AWHlLE*=CRELATlON LEG 26) THEN % "WHILE IN" 
ELSE RELATI0NI*31-RELATI0N; % "UNTIL IN" 
RELATlON:sREUATiON,C46*2l; % 0*1*2 
IF CITERC*@URCNT)>63 THEN 

BEGIN 

TOGL«-0URCNTJ ITERC*63j 

do cra until c t0gl*t0gl"63 ) <63 
iterotogl; 
end; 
if more and iterc>o then cra; 

END ELSE 
BEGIN 

CHAR:=0&CHAR[36J42»63; RELATlONJsRELATlON,U3?331 
IF ClTEROQURCNT)>63 THEN 
BEGIN 

togl*ouRcnt; iterc*63; 
00 crepl until c tq6l*t0gl-63 )<63 or not more; 
iterc+togl; 

end; 
if more and iterc>o THEN CREPl^ 
end; 
tf more and hiscnt>0urcnt then 

p6LlSHCCDEST[DOFF&OWI£305 33;i53 33fDEL* 
CS0RCCS0FF&SWI[30J33:I5 3 3 3,DEL); 
IF UPDTOG THEN CHAR*DOFFSDWI [ 30 : 33 J 15 3*DPTR, DOT; 
END;% CONDITIONAL XFER OF 6-BlT CHARS DONE 
IF UPDTOG THEN 

BEGIN 

upctddc0 3*hiscnt,[35s133-char; 
updp0d[0]«-dptr&( optr.oot+char )amper; 
upsp0q[q3*sptrsc sptr .dot + chap, jamper; 
end; 

END REPL; 



(MUST INVERT) 



08425400 
08425420 
08425440 
08425460 

08425480 
08425500 

08425520 
08425540 
08425545 
08425550 
08425560 
08425580 
08425600 
08425620 
08425640 

08425660 
08425680 
08425700 
08425720 
08425740 
08425760 
08425780 
08425800 
08425820 
08425840 
08425860 
08425880 
08425900 
08425920 
08425940 
08425960 
08425980 
08427840 
08427860 
08427880 
08427900 
08427920 
08427940 
08427960 
08427980 



T 
T 

T 
T 

T 

P 

T 
P 
C 
C 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0296»0 
0299*1 
0302*0 
0304*2 

0307*0 
0307*3 
030852 
0309*0 
03I0«1 
031252 
031353 
0315*0 
031552 

0317*0 
032150 

0321*3 
0321*3 
0325*0 
0325*0 
0325*2 
0328*2 
0329*3 
0330*1 
033153 
033650 
0336*3 
0336*3 
0340*0 
0340*0 
341 ,11" 

0343*2 
0345*1 
0348*3 
0348*3 
0349*0 

0349*2 
0351*1 

0354*0 
0356*3 
035653 



size* 0357 words 



PROCEDURE COMPARE; 



BEGIN 
COMMENT 



%043 
START OF REL 



STRING/POINTER COMPARISON INTRINSIC FOR 85500 



march 1968, pointer updates 
major rewrite to correct bad 
ratchford; 

COMMENT THERE ARE FOUR FLAVORS 

1. <AEXP> IN ALPHA. AEXP 

2. <PEXP1>*<PEXP2> OR <PEXPl> 
RELATI0N = 65 FOR = & 66 FOR 



ADOED FOR STRING CMPR 
ALGORITHM^-OCT 69i 



TS ALGOL* 
JUNE 1968. 



OF STRING/POINTER COMPARES 

IS IN [425063 OF F-7, RELATl0N*29 f 

/ <PEXP2>. 

X 



3, <PUP1»S<P£XP1> <RELATION> <PUP2> ! <PEXP2> FOR <C0UNT> 



08430000 

segment; DISK 

08430020 
08430040 
08430060 
08430062 
08430080 
08430100 
08430120 
08430140 
08430160 
08430180 



T 0000*0 
ADDRESS * 



0000*0 
0000*0 
0000*0 
0000*0 
000050 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



00577 



€1 



• 

• 



4. <PEXPl> <RELATI0N> <L 
VALUES OF <RELATION> 
F-FIELD OF F-2 IS LEN 
OF <COUNT> IN SOURCE 
RELATION HAS SIGN-BI 

DEFINE 

D0TaC18U3]#* 

AMPERatl8*35*133## 

CSIZE*E31*023*» 

INTEGER 

RELATION ="01* 
HISCNT =-02' 



ITERAL> FOR <COUNT>. 

ARE SAME AS FOR SCAN & REPLACE* FOR #4# 

GTH OF LITERAL STRING 8 C"FIELD IS VALUE 

STMT (8192 IF OMITTED), 

T«l FOR CASE #4, 






P2 

LITERAL 

PI 

CHAR 

R1C# R1W* 

R2C» R2W* 

N*. 

LOOPCOUNT 

JUNK 
REAL RJUNKsJU 
BOOLEAN 

RESULT 

done; 

NAME 

UPP2D0 

UPP1D0 

M 
ARRAY 

R0W1.C*3* R 

subroutine fi 
begin; 
stream<n:r 

BEGIN 

si«-ri; 

0I«-DI+R 
IF N SC 
N«-TALLY 

end; 
if not cdq 

BEGIN 

R1C*-P0L 

RlW*POL 

R2C*PQL 
R2W«-P0L 
END UPD 

end findit 
subroutine co 
begin; 

STREAMCREL 
BEGIN 

si*ri; 



s"03» 

= P2 * 
s*07# 
■ Pi , 



*P2* 
= 17; 

nk; 



'Pi. 



""OH* 
"-05* 

- 02; 

ow2C*3; 
ndit; %fi 



six*oo#; 

%same codes as for scan/replace. 
%length of literal in f-fieldf 
xlength of compare in c-field, 

^SOURCE STMT IS "Pi RELATION P2 FOR 

XHI.S.CNT" 

%P2 MAY BE A LITERAL OF 1*>8 CHARS, 

SLOGAN OF CHAR FOR "CHAR IN ALPH A« 
XCHAR & WORD OFFSET FOR Pi 

^LENGTH OF COMPARE FOR CURRENT CALL OF 

XFINOIT. 

SUSED FOR LITERAL COMPARISONS, 



%THIS IS ALSO ONE OF THE POINTER ARGS, 
XSOMETIMeS MEANS WE FOUND SOME i CHARS, 

XDD FOR UPDATE OF P2 POINTER. 



%ARRAY ROWS REFERENCED BY P1/P2, 
ND BLOCK OF 64 CONTAINING 1ST * CHARS, 



1c*r2c»r1*cr0w1cr1w]]*r2*i;r0w2[r2w]]); 

si*si+ric; 
lly*-i; 



2c; 

/DC THEN TA 



NE*PQLISH) 

%SE 
ISHCR1C&R1W 
ISH,C35S 103 
ISHCR2C&R2W 
ISH, t 35: 103 
ATE OF CHAR 

; 

mp; %co 



THEN 

T UP WORD & CHAR OFFSET FOR NEXT CALL, 

[35l38llO]+N*DUP>, [A5!03]J 



C35»38*lO]+N»DUP), [45*033; 

* 

t 

AND WORD INDICES; 

MPARE 2 * CHARS FOR < OR >, 
ATlON!RlC>R2C>Rl<-CROWlrRlW]J>R2*rROW2CR2W3 3); 

SUSI + R1C/ 



08430200 
08430220 
08430240 
08430260 
08430280 
08430300 
08430320 
06430340 
08430360 
08430380 
08430400 
08430420 
08430440 
08430460 
08430480 
08430500 

08430520 
08430540 
08430560 
08430580 
08430600 
08430620 
08430640 
08430660 
08430680 
08430690 
08430700 
08430720 
08430740 
08430760 
08430780 
08430800 
08430820 
08430840 
08430860 
08430880 
08430890 
08430900 
08430910 
08430920 
08430930 
08430940 
08430950 
08430960 
08430970 
08430980 
08430990 

08431000 
08431010 
08431020 
08431030 
08431040 
08431050 
08431060 
08431070 
08431080 
08431090 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
00G0*0 

0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0001*0 
000i?0 

0003*2 

0003*2 

0004*1 
0004*3 
0005*3 
0006*0 
0006*1 

0007*0 

0007*2 

0010*2 
0011*2 
0014*2 
0015*2 
0015*2 
0015*3 
0016*0 
0016*0 
0018*2 
0018*2 



• 
# 



• 



* 



* » 



CALLED IF FINOIT FINDS 2 X CHARS,, 

* 

t 

Dl*OIMJ 



0I+DI + R2O 

COMMENT COMP SHOULD ONLY BE 

63CIF SCXQC THEN JUMP OUT); 

si«-si-i; 

ci«-ci+relation; 
go gr; 
%go ls; 
lssif sc<oc then ; go xx; 
gruf sc>dc then i % go xx; 
xx'if toggle then tally<-1; 
relation«-tai_ly; 
end collating s£q compare/ 
done*polish; 

END CSMP; 
hiscnt * CHISCNT> 0) x hiscnt; 
if relation, u3*5] geq 29 then % in alpha* numeric* truthset 

begin; 

comment char in alpha test; 

stream(tallie ! =0 i char* i t s j =rel ati on . [ 46 : 2 ] 

BEGIN 

Sl<-LOC CHAR; Sl*Sl + 7; 

cijsci+itsj QQ to alp; GO TO nmr; % GO TO tset; 
tstj sis*tset; skip char sb; skip sb; 

if sb then begin tallyjm; tallIe : stall* end; go oun; 
nmr; if sc GEQ "0" then if sc leq **9 m then % 

begin tallys*i; tallie:«tally eno; go dun; 

if SCsALPHA then begin tallyi»i; tallie»=tally 



IF 



# 

• 



'1* TSETIwtHISCNTj). 



END* 



ALP* 
DUN: 

end; 
result*polish; 
end else 

helati0n>64 then 

comment plap2 or p 1*p2 * comp are the absolute addresses that the 
2 pointers reference without looking at the contents of these 
locations. note that uninitialized pointers compare equal*** 
result<-(relati0n = 65) eqv ( pi , [ 18 s 30 3*p2 , [ 18 * 30 ] ) . else 

BEGIN 

COMMENT A RELATIONAL COMPARISON OF TWO STRINGS.; 

COMMENT NOTE THAT THE 5500 SIMULATIONS USE THE BCL COLLATING 

SEQUENCE FOR RELATIONAL COMPARISONS* WHEREAS THE 6500 WILL 

COMPARE THE MAGNITUDES OF THE TWO CHARACTERS AS «- 6- OR 8*BIT 

INTEGERS, THE 5500 SIMULATION A|_SQ ONLY ALLOWS 6-BIT BCL CHARS! 

IF CP2=0 AND RELATION, tlllJaO) OR Pl*0 

THEN PCMKS, INTCALLC("4)&H2U7in,F0RTERRl)) ; 
IF Pi, [01*013 THEN 

PCMSl[14»47:Q13,Pl,[09*22 3+<Pl.[33*15]/0)*CHS,CDC*DEL)* 
IF P1.CSIZEXSIX THEN POLISHC MSI [ 14 » 47 * 01 3 #8686* CDC*DEL ); 
R0W1*M[P1J; RlC*Pl,C28»03]j 

R1W*P1.[18U03J HISC NT *ABS (HISCNT); 

IF (JUNK«-HISCNT.C35M31+PI»00T)>0*(RGHI)[35*08I10] THEN 

POLISH([ROWi[JUNK33tDEL)* 
IF RELATION, [01*013*0 THEN 

BEGIN 

COMMENT BOTH P14P2 ARE POINTERS; 

IF P2.C01I01] THEN 

P(M&i[ 14$ 47? 01 3 *P2.C09*22 3+CP2.C33H5 3*0)*eHS»CDC*DEL) s 
IF P2,CSIZEXSIX THEN 



08431100 
08431110 
08431120 
08431130 
08431140 
08431150 
08431160 
08431170 
08431180 
08431190 
08431200 
08431210 
08431220 
08431230 
08431520 
08431540 
08431560 
08431580 
08431600 

08431620 

08431640 

08431660 

08431665 

08431670 

08431675 

08431680 

08431685 

08431690 

08431695 

08431700 

08431720 

08431740 

08431760 

08431780 

08431800 

08431820 

08431840 

08431860 

08431880 

08431900 

08431920 

08431940 

08431945 

08431946 

08431950 

08431951 

08431960 

08431980 

08432000 

08432020 

08432040 

08432060 

08432080 

08432100 

08432110 

08432111 

08432120 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
P 
T 
T 
P 

T 
T 
P 
C 
C 

c 
P 
c 
c 
c 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0019*1 
001913 
001913 
0021 1 1 
002H3 
0022H 

0022*2 

0022*2 

0023*1 

0023*3 

0024*1 

0024*2 

0024*3 

0025*1 

0025*2 

0029*3 

003110 

003182 

003l»2 

0034*0 

0034*1 

0034*3 

0035*3 

0036*3 

0038*0 

0039*0 

0039*3 

0040*3 

0040*3 

0041 '0 

0041 *2 

0041*2 

0042*3 

0042*3 

0042*3 

0042*3 

0046*2 

0047*0 

0047*0 

0047*0 

0047*0 

0047*0 

0047*0 

0049*2 

0054*0 

0054*3 

0059*2 

006 3 J 1 

0066*0 

0068*1 

0072*1 

0073*2 

0074*3 

0075*1 

0075*1 

0076*0 

0080*3 



n 



# 

* 



IF 
IF 
IF 



THEN 



OR done; 



PQLISH(«&1C14:<I7I01]# 8686, CDC > DEL ) t 
R0W2^MCP2]; R2C<-P2,t26SQ3H 

R2N*P2.C18«10]J 
IF ( HI SC NT+P2, DOT )>0«(R0W2>[ 35*08* 103 

P0LlSH([R0W2tHISCNT+P2.D0T]3#DEU)) 
IF (JUNK*HISCNT)>63 THEN 
BEGIN 

N*63; 

do findit until c ( junk«-junk"63)<63) 
end; 
if (not done) and cn*junk)*0 then findit; 

END ELSE 

BEGIN 

COMMENT P2 IS A LITERAL STRING* 

IF CN«-HISCNT,C18;15]) = THEN N*HlSCNT; 

RJUNK«-P2; RO W2«- 1 R JuNKI &1 C 17 I 47*011; 

R2W«-o; 

COMMENT IF HISCNT.U8U53/0 THEN C18U5]«STR ING LENGTH & 
C33:151=EXPLICIT LENGTH OF COMPARE, OTHERWISE* E33*l53 
BOTH LENGTH OF COMPARE AND LENGTH OF LITERAL.; 
(HISCNT*HISCNT.C33I15])SN THEN 
BF" G I N 

comment length of compare is < length of literal! we oon"t 

have to repeat the literal; 
r2c*8*n; findit; 

END ELSE 

begin; 

comment literal must be duplicated to fill 



IS 



IF 



OlV N,N2«-(JUNK*8 



si*si+sofp; 

sud); 



d*si; 



ELSE 8; 



STREAM (P2,N,S0FF<-8"N,N 1*8 
D«-[JUNK1); 

BEGIN 

SI*LOc P2; 

N1CDS<-N chr; 

ds«-n2 chr; 

end; 
n + if hiscnts8 then hiscnt 
loopcount«-hiscnt-n; 
findit; 

IF NOT DONE THEN 
BEGIN 

R2C<-Pl, [285033; 

R0W2*R0Hi; 

IF L00PC0UNT>63 THEN 

BEGIN 

N<"63> 

DO FINDIT UNTIL DONE 

end; 

(not done) and ( n*loclpcount )xq 



8 CHARS 

MOD N), 



R2C<-0; 



R2W*Pl f C18I103; 



OR (L00PC0UNT«-L00PC0UNT«63)563; 



THEN FINDIT; 



IF 

end; 

END 

end; 

8EGIN 

UPP1DDC0] * PI +0&HISCNTC18I35»13JJ 

UPP2DDC01 *■ P2 +0&HISCNTC18:35U3]; END; 

CRELATI0N<-ABSCRELATI0N))s8 THEN RESULT*CNQT DONE ). U7 * 01 3 ELSE 

RELATI0N=12 THEN RESULT«-DONE ELSE 

DONE THEN 



08432140 


T 


0082*0 


08432160 


T 


0084*2 


08432180 


T 


0087* 1 


08432200 


T 


0088*2 


08432220 


T 


0091 S2 


08432240 


T 


0093«3 


08432260 


T 


0095*0 


08432280 


T 


0095*2 


08432300 


T 


0096*1 


08432320 


T 


0099*3 


08432340 


T 


0099*3 


08432380 


T 


0103*0 


08432400 


T 


0103*0 


08432420 


T 


0105*0 


08432440 


T 


0105*0 


08432460 


T 


0108*0 


08432480 


T 


0110*2 


08432481 


T 


0111*1 


08432482 


T 


0111*1 


01432483 


T 


0111*1 


08432500 


T 


0111*1 


08432520 


T 


0113*0 


08432540 


T 


0113*2 


08432560 


T 


0113*2 


08432580 


T 


0113*2 


08432600 


T 


0116*0 


08432620 


T 


0116*0 


08432640 


T 


0116*2 


08432660 


T 


0116*2 


08432680 


T 


0120*0 


08432700 


T 


0120*2 


08432720 


T 


0120*2 


08432740 


T 


0121*2 


08432760 


T 


0123*0 


08432780 


T 


0123*2 


Q8432800 


T 


0123*3 


08432820 


T 


0126*2 


08432840 


T 


0128*2 


08432860 


T 


0130*0 


08432880 


T 


0130*2 


08432900 


T 


013110 


08432920 


T 


0133S2 


08432940 


T 


0134*2 


08432960 


T 


0135*1 


08432980 


T 


0135*3 


08433000 


T 


0136*2 


08433020 


T 


0140*3 


08433040 


T 


0140*3 


08433060 


T 


0144*0 


08433120 


T 


0144*0 


08433140 


T 


0144*0 


08433141 


T 


0140*0 


08433142 


T 


0144*0 


08433143 


T 


0146*1 


08433145 


T 


0148*2 


08433147 


T 


0151*2 


08433149 


T 


0154*2 



♦ < 



€ 



sfindit discovered a i char in the two strings, 
♦relation, [45*011; xo & 16 test >* 4 & 20 test 
result*done; 



BEGIN 
RELATlON< 

comp; 

END ELSE 

COMMENT STRINGS WERE * AND RELATION IS NOT : 
"-» HALF OF "<" OR ">" OUT OF RELATION,; 



• 



END C~,.w, 

end compare; 



"k" HALF OF "<" OR ">" 

RESULTS-RELATION, [43:01 3; 
i COLLATING SEQUENCE COMPAR 
IMPAREJ 



OR ">" OUT 

!ES; 



OR *. PLUCK THE 



08433151 
08433153 
08433155 
08433157 
08433159 
08433161 
08433163 
08433320 
08433340 



0155*1 
0155*3 
0i57«0 

0158*3 
0158*3 
0158*3 
0158*3 
0160*2 
0160*2 



SIZE" 0161 WORDS 



PROCEDURE BASICPRINTCTYPE) 



VALUE 
REAL 



type; 
type; 



BEGIN REAL 



• 



REAL 
ARRAY 
NAME 
REAL 



BOOLEAN 
INTEGER 



ALGOLWRITE = 12* 
ALGOLSELECT c 14; 

rcw « +o; 

POT s 25f*]; 

M = 2> 

T* 

WH1* 
WH2; 

thistype; 

8SIZE* 

BUFF* 

BUFFLOAD* 

COL* 
COUNTER, 

E> 

ESIGN* 
EXPCHR/ 
I* 
ITEMS, 

NUMCHR* 

NUMROWS, 

ROW, 

rowlength* 

sign* 

skip* 

TAB* 

writestmt; 

POINTER; 

filx; 

STRING s T; 

fibt *3* 

MATRIXC*]* 
MATRIXROWC*]; 
BOOLEAN DATACOM* FIRSTIME* 
LABEL COMMON* 

LOGEIGHt* 

MAXINT' 

MINVALUE* 



NAME 
NAME 
NAM E 
ARRAY 



08500000 T 0000*0 
START OF REL SEGMENT; DISK ADDRESS * 

08500100 T 0000*0 

08500200 T 0000*0 

08500300 T 0000*0 

08500400 T 0000*0 

08500450 T 0000*0 

08500500 T 0000*0 

08500600 T 0000*0 

08500700 T 0000*0 

08500800 T 0000*0 

08500900 T 0000*0 

08501000 T 0000*0 

08501100 T 0000*0 

08501200 T 0000*0 

08501300 T 0000*0 

08501400 T 0000*0 

08501500 T 0000*0 

08501600 T 0000*0 

08501700 T 0000*0 

08501800 T 0000*0 

08501900 T 0000*0 

00502000 T 0000*0 

08502100 T 0000*0 

08502200 T 0000*0 

08502300 T 0000*0 

08502400 T 0000*0 

08502500 T 0000*0 

08502600 T 0000*0 

08502700 T 0000*0 

08502800 T 0000*0 

08502810 T 0000*0 

08502900 T 0000*0 

08502950 T 0000*0 

08503000 T 0000*0 

08503100 T 0000*0 

08503200 T 0000*0 

08503300 T 0000*0 

08503325 P 0000*0 

08503400 T 0000*0 

08503500 T 0000*0 

08503600 T 0000*0 

08503700 T 0000*0 



00583 



€ 



• 



• 



DEFINE 



DEFINE 



te^seven, 

TENSIX; 

CONVERTED* 

NORMALi 

DUMMYLABELi 
P(LOGEIGHT)#, 
PCMAXlNT) tt 
P(MINVALUE)#> 
PCTENSIX) t» 
P(TENSEVEN)#; 
1#> 



LOGS - 

MAX B 
DELTA* 
TEN6 » 
TEN7 * 
COMMA ' 



STRINGS?^' 



SEMICOLON = 2#, 

ENDLINE a 3*; 



REAL SUBROUTINE GETNEXT; 

BEGIN THISTYPE * CTYPE * O&T YPE C6 : 7 J 40] ) , [6 : 13 \ 

ITEMS «• ITEMS-I; TAB * *C1 INX POINTER); 

P(*^0INTER); POINTER «■ 2 INX POINTER; 

getnext «- polish 
end getnext; 

boolean subroutine dimension; 
begin comment true for single dimensioned (includes 

stream(t*pqlish(xcm, 0* cdc)*a*0); 

begin si«-t; oi«-t; si*si-i6; skip 2 sb; 
if sb then else tally*i; t * tally; 

end stream; 

dimension «■ thistype or polish; 
eno dimension; 
subroutine setupandex i tj 
begin if datac0m then 

if counter neq then 

begin;streamcbuff); ds«=lit •»«-»; 

POLISHCMKS* \ht Of 0* BSIZE# 
BUFF ?5 "C*FILX).CCF]; 

end; 

FIBC2O]i»BUFF&C0UNTER[3«33U53jBSlZE[iei3Bll03in29l47ll31 

polishcxit); 
end setupandexit; 
subroutine print* 

rfgln p(mks>1*0>0,bsize+<(not dat acqm ) , [ 47 * 13 )» filx, algolwrite ) i 
if mot datacom then 
stream(a:= ,, 10"*b: = cfibco]3 ); 
begin sis=loc a; dsi*8 add; end stream; 
end print routine; 
subroutine clear; 
begin; stream <a«-bsize-i+datacomio**filx>; 

BEGIN DS:=8 LIT M M ; sn=o; DS:=A wds; 
BUFF5=P0LISH; BUFFL0AD«=BSIZEx8; 
END CLEAR ROUTINE; 
SUBROUTINE CHECKPRESENCE; 

BEGIN FIB[20 3<-C*PCOUP>)&CCQUNTER«-O)[3*33il33; 
BSlZE«-PCMKS*l*0,0#(-l)>FILXf ALGOLWRITE)* 
IF DATACaM«-FIBC43.C8J4] = lO OR FlBC 4] , C 8 S 43 = 1 .3 
BSIZE «■ 9 ELSE 
BEGIN BSIZE«-BSIZE-i; 

STREAMCA«-FlBC03>9*BSlZE INX (*FILX)); 



FILX* ALGOLWRITE); 



dijsd; a?=di; end; 



THEN 



08503800 
08503900 

08504000 

08504100 

08504200 

08504300 

08504400 

08504500 

08504600 

08504700 

08504800 

08504900 

08505000 

08505100 

08505200 

08505300 

08505400 

08505500 

08505600 

08505700 

08505800 

08505900 

08506000 

08506100 

08506200 

08506300 

08506400 

08506500 

08506600 

08506700 

08506800 

08506810 

08506820 

08506830 

08506850 

08506860 

08506900 

08507000 

08507100 

08507200 

08507300 

08507310 

08507320 

08507330 

08507340 

08507400 

08507450 

08507500 

08507550 

08507600 

08507700 

08507800 

08507825 

08507850 

08507855 

08507860 

08507870 



T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

000l*0 

0003*3 

0006*2 
0008*1 
0008*1 
0008*3 
0009*0 
0009*0 
0010*3 
0011*3 
0013*0 
0013*1 
0014*0 
0014*1 
0015*0 
0015*1 
0016*2 
0018*2 
0020*1 
0022*0 
0022S0 
0026*1 
0026*2 
0026*3 
0027*0 
0030*0 
0030*2 
0032*1 
0033*0 
0033*1 
0034*0 
0036*2 
0039*0 
0041*0 
0041U 
0042*0 
0045*0 

0047*2 
0051*1 
0052*2 
0054*1 






• 



• 1 



• 
• 



* E-l 



begin si*loc a; ds*wds; end; 

ENDJ 

clear; 
end checkpresence; 
subroutine printexit; 
begin print* 

counter <- oj 

setupanoexit; 
END prinTexit; 
subroutine printreturn; 
begin print; 

checkpresence; 
end printreturn; 
subroutine fimde; 
begin comment determine the exponent of a real number. 

IS POSITIVE AND PASSED IN T, WHEN DONE* STORE THE 

EXPONENT IN Z, AND ROUND T TO 10*6 $ T < 10*7; 

E «- C(O&TC42»3«63«T[H2M] + 12>xL0G8)+0.5; 

WHILE T<(IE E>0 THEN P0T[E3 ELSE 1/P0TC-E3) DO E 

T «• IF (6-E)>0 THEN TxP0T[6-E3 ELSE T/POTCE'63; 
END FIND EXPONENT AND ROUND NUMBER; 
SUBROUTINE CONVERT; 
BEGIN 

IF THISTYPE THEN 

BEGIN; STREAM(A*-0IS*STRING); 

BEGIN Sl*s; SI+SI+15J DIALOG A; 01*01+71 

if ci «• polish+6)>i5 then i * 1-20; 

NUMCHR := I + 3 x WRITESTMT; 
IFCCOUNTER + NUMCHR) GTR bUFFLOAD THEN PRINTRETURN; 
STREAM(I:STRlNG*WRlTESTMT,BUFF); 

begin substring; writestmt(ds*lit ♦♦"•*}; os*i chr; 

writestmtcds*lit mmm ; ds*lit "# h ); i*di; 
end stream; 
buff ?= polish; counter :* counter + numchr; 

go to converted; 
logeights : 5 ^11 57 16 30 347 6 1674; 
end string handling; 
comment that was easy -- now 
esign <- expchr «- sign * skip 
sign *• t*ct * absct)); 
if t<max then 
if (if t = then true else cabsccci «• t )-t ) /t ) <delta ) ) 

BEGIN; COMMENT INTEGER, OR NEAR ENOUGH; 
STREAMU*! * TU+[WHl3); 



THE NUMBER 



ds*chr; end; 



FOR THE NUMERICAL STUFF; 
* NUMCHR *• 0; 



THEN 



dec; si*t; 

Sl«-Si + n; i*Sjj 



BEGIN SI«-LOC I; DS«-8 
7CIF SC* M M THEN 
END stream; 

NUMCHR + 8-CSKIP «■ P( XCH ) , C 30 * 3 3 ) ; 

GO TO common; 
end integer case; 
t * i,o*t; finde; 
if (i <• t)>tfn7 then 
begin i *• ten6; e * £+1; end; 
if e<0 and e>(-7) then 

IF I = ((I DIV (T <• P0TCABS(E + l)3))xT) THEN 
BEGIN I «• I DIV T; 



08507880 
08507890 
08507895 
08507900 
08508000 
08508100 
08508200 
08508300 
08508400 
08508500 
08508600 
08508700 

08508800 

08508900 

08509000 

08509100 

08509200 

08509300 

08509400 

08509500 

08509600 

08509700 

08509800 

08509900 

08510000 

08510100 

08510200 

08510250 

08510300 

08510400 

08510500 

08510550 

08510575 

08510600 

08510650 

08510700 

08510750 

08510800 

08510900 

08511000 

08511100 

08511200 

08511300 

08511400 

08511500 

08511600 

08511700 

08511800 

08511900 

08512000 

08512100 

08512200 

08512300 

08512400 

08512500 
08512600 

08512700 



T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

P 

T 

T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 



0056«1 
0057*0 
005750 

0058*0 
0058*1 
0059*0 
0060*0 
0060*3 
0062*0 
0062* 1 
0063*0 
0064*0 

0065*0 

0065*1 

0066*0 

0066*0 

0066*0 

0066*0 

0070*1 

0078*0 

0083*3 

0084*0 

0084*0 

0084*0 

0084*1 

0086*0 

0087*2 

0090* 3 

0092*2 

0095*0 

0096*3 

0098*3 

0100*3 

0101*0 

0102*3 

0102*3 

0103*1 

0105*0 

0105*0 

0105*0 

0107*3 

010913 

0110*2 

0115*2 
0116*0 

0117*3 
0118*2 
0120*0 
0120*1 
0122*2 
0123*0 
0123*0 
0125*0 
0126*1 
0128*3 
0130*3 
0134*2 



€ 



H 



STREAM CP1*0IP2«-P(ABS(E + 1)#0UP)# 

P3*-7-PtxCH),P44-P(0UP)-l»P5*I*P6*CWHiJ); 

BEGIN QS<-2 LIT "0« M ; P2CDS <- LIT M 0«); 

SI«-LOC P5; 0S«-P3 DEC* pi«-di; DI«-P6; SI*P1J 
SI*SI-i; P4UF 5C* M Q M THEN JUMP OUT? 

TALLY*TALLY + l; SI*SI»1)J 

putally; 
end stream; 
numchr <- 9-pcxch)/ 

GO to common; 

END F TYPE STUFF; 

IF E>0 AND E<7 THEN 

BEGIN COMMENT THE OTHER HALF OF F-FORMATTlNG; ; 

STREAMCPO«-0: P1*P(E + 1# DUP)> 

P2«-7-P(XCH)* P3*I* P4*EWH135; 

BEGIN Ol*DI + i; SI«-LOC P3; 0S«-7 DEC; 

oi*p4.; si«-P4; susi + i; ds*pi chr; 
ds«-lit ".»; si<-si+P2' si^si-i; 

P2dF sc*"0" then jump out; 

TALLY*TALLY + i; SI*SI-l)i ROYALLY; 

end stream; 

NUMCHR * 8-PUCH); GO TO COMMON; 
END OTHER HALF FORMATTING; 
STREAMCPl*ABSCE)-IP2*I#P3*tE3#P4*tWHt])J 

begin dl*-di + i; sh-loc p2) ds*7 dec; di«-p4; si«-p4; 
si*si+ij ds*chr; ds*lit •*.*; si*si*5; 
6cif 3c*"0" then jump out; si*sl-u t ally«-t ally* 1) t 
oi*P3* si<-loc pi; di*di+6; os«-2 oec; pi*tally; 

end stream; 

expchr «• 1 + cabs(e)>9); eslgn * e<0; numchr ♦ 8»p(xch?; 
commons? t ♦ l + numchr + expchr^((expchr^o)4p(dup)) + writestmt; 

IF (C0UNTER+T)>8UFFL0AD then printreturn; 

STREAM <P1«-SK IP J NUMCHR, S I 6N*EXPcHR>P2*P COUP )*0# 

ESlGN*P3«-[WHl3»P4«-[E]*HRITESTMT#BUFF); 

begin ds«-lit « "; signcdi«-dwj ds*lit "-"3; 

si<-P3; si*si+pu ds«-numchr chr; 

p2(ds«-2 lit m e+ m ; esigncdi>di*i; DS«-LIT «- M ); 
si+pa; si*si+e> si*si«expchr; ds<-expchr chrj; 

writestmtcds*lit m *">; pudi; 
end stream; 

buff * polish; counter «■ counter+t; 
go to converted; 




converted? 
end convert* 
subroutine tabcontrol; 

BE ^.», *.« U u«»,-r norc an,, 




08312800 
08512900 
08513000 
08513100 
08513200 
08513300 

08513400 
08513500 
08513600 
08513700 
08513800 
08513810 
08513820 
08513830 
08513840 

08513845 
08513850 
08513855 
08513860 
08513865 
08513870 
08513880 
08513890 
08513900 
08514000 
08514100 
08514200 
08514300 
08514400 
08514500 
08514600 
08514700 
08514800 
08514900 
08515000 
08515100 
08515200 
08515300 
08515400 
08515500 
08515600 
08515700 
08515800 
08515900 
08516000 
08516100 
08516200 
08516300 
08516400 
08516500 
08516600 
08516700 
08516800 
08516900 
08516910 
08517000 
08517050 



013611 
0138*1 
0140*2 
014211 
0143*3 
0145*2 

014611 
0146*2 
0146*3 
0148*0 
0150*0 
0150*0 
0151*3 
0152*1 
0154*0 

0155*2 
0156*1 
0157*2 
0158*3 
0160*1 
0161*1 
0161*2 
0163*1 
0163*1 
0165*1 
0166*2 
0167*3 
0169*3 
0171*0 
0171*1 
0175*3 
0179*3 
0183*0 

0185*1 
0186*3 
0188*3 
0190*0 
019282 
0194 * 1 
0195*3 
0196*0 
0197*3 
0198*1 
0198*4 
0200*0 
0201*0 
0202*0 
0203*0 
0203*0 
0203*1 
0204*0 
0204*0 
0204*3 
0207*1 
0208*3 
0211*0 
0211*0 



# 
• 



r » 



T*=PCDUP), [36:63);% 
BEGIN 

SlJ* LOC TAB; SKIP SB; 
IF SB THEN 
BEGIN 
Siss a; TCSIJ* Sl- 

sn= si - tab; 

END ELSE 
BEGIN 

si? = a; tcsi:= si 
si := si + tab; 
end; 
a:= si; 

end stream;* 

buff:=polish; 

space fwd thru 



comment space 
32; sijs si - 



backward; 
3?); 



COMMENT SPACE 

+ 32; si:= si 



forward; 
■»• 32); 



END 



counter«=tab;% 
buffer;* 

end else begin comment normal tab control function) 
if tab=endline then printexit; 

IF WRITESTMT « Q THEN BEGIN 
IF TAB=COMMA THEN 

T * COUNTER-CCOUNTER * £ C CQUNTER+14 ) DIV 15)*15) 
ELSE IF TABaSEMICOLON THEN 

T * = COUNTER-CCOUNTER 8 = £ C COUNTER+S ) OIV 3) x 3); 
IF COUNTER>BUFFLOAD then printreturn else 
if tab/o then begin; 
stream(buff;t); 

begin si*buff; si*si+t; buff*si; end; 
buff «• polish; 

END END END END TABCONTRQL; 

comment*********start of code******; 

items «• type.cu6]; writestmt * type. [46813; 

pointer «■ 1 inx urcw3&rcw[ftc]); 

filx * *pointer; filxcnot 4] + *(l inx pointer); 

pointer «• 2 inx pointer; 

fib «• filxcnot 23; 

IF FIBC5J.U3I13 THEN P(MKS> 0, 0, FILX* 1* ALGOLSELECT 3 1 
IF FIBC03-0 THEN BEGIN F IB CO 3 5 s"1000"; THIST YP£ { ?TRUE; END; 
DATACOM «• FIBC43.C8I43 a 10 OR FIB[43,[8*43 s 13; 

if (counter «• (t * f ibc20 3 ) , c 3 : 153 )»0 then checkprfcsence else 
begin buff «■ t. [30*183; buffload «• 8x(8slze * t , c 1 8 s j 3 ) end; 
if thistype and fib c 4 3 , c8 * 4 3=4 then 

p(*cfibc1433>?'#cdc>1>ssn,xch,std); 
if datacom then clear 
else if fibc213 neq then p(filx*8* 1 1 'com ) ; 
tab*s *pointer; pointer** i inx pointer; 
firstlme * = true/ tabcontrql; 
items = then setupandex it; 
not type then go to normal; 
begin comment matrix print routine; 
polishcmatrix «- getnext); 
if p(ta8* dup)=endline then tab «• comma; p(xch); 

IF DIMENSION THEN 

BEGIN COL * THISTYPE + i; ROWLENGTH «• MATRI X, C 8 * 10 3 ; 
00 BEGIN 

T <- CMATRIXCCOL33; 

convert; tabcontrol; 
end until (col «■ col+thist ype+1 )*rowlength; 



IF 
IF 

DO 



08517060 

08517100 

08517110 

08517120 

08517130 

08517140 

08517150 

08517160 

08517170 

08517180 

08517190 

08517200 

08517210 

08517300 

085174Q0 

08517410 

08517500 

08517600 

08517650 

08517700 

08517800 

08517900 

08518000 

08518100 

08518200 

08518300 

08518400 

08518500 

08518600 

08518700 

08518800 

08518900 

08S18910 

08518920 

08519000 

08519100 

08519150 

08519175 

08519200 

08519300 

08519320 

08519330 

08519350 

08519360 

08519400 

08519410 

08519500 

08519600 

08519700 

08519800 

08519900 

08520000 

08520100 

08520200 

08520300 

08520400 

08520500 



T 

P 
C 

c 

c 
c 
c 
c 
c 
c 
c 
P 
c 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
P 
C 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



021282 
021382 
0213*2 
021480 
021452 

021482 

021680 

021682 

021683 

021683 

0218*1 

021883 

021883 

021910 

021981 

022Q82 

022082 

022180 

022310 

02248J 

022580 

022781 

023080 

023383 

023680 

023783 

023980 

024081 

024Q83 

024180 

024180 

025083 

025212 

025650 

025751 

025980 

026280 

026582 

026981 
0273J0 
027882 
028082 
028351 
028483 
028880 
029081 
029280 
0294*0 
029483 
029483 
0296*2 
029980 
030080 
0303'1 
0303*1 
030481 
0306*0 






• 






€1 



P0LISH)*ENDUNE THEN PRINTEXIT; 



MATRIX, [8«l03J 
* C*[MATRIXCRQW 



«■ l]3).C8H0)i 
*[MATR!XtROW33; COL «• i; 



• 



IF (TAB «- 
END ELSE BEGIN 
NUMRQWS «• 
ROWLENGTH 
DO BEGIN 

MATRIXROW 

00 BEGIN 

T * [MATRIXRQWCCOLn; 

convert; tabcqntrol; 
eno until (col <■ col + 1 )*rowlength; 

IF COUNTER/0 THeN PRINTRETURN; 

end until (row «• row+1 )«numrows; 
if (tab ♦ pollsh)sendline then setupandexit; 
end; 
end until (pointer inx )u [ type 3 . c cf3 ; 
setupandexit; 
normal? do begin t * getnext; 

convert; tabcontrol; 

END UNTIL (POINTER INX 0)=[TYPe3 
SETUPANDEXIT; 
END BASIC PRINT ROUTINE; 



tCF3 



08520550 


T 


0308*3 


08520600 


T 


0311 10 


08520700 


T 


0311*2 


08520800 


T 


0313*0 


08520900 


T 


0315*1 


08521000 


T 


0315*1 


08521100 


T 


0317*1 


08521200 


T 


0317*1 


08521300 


T 


0318*1 


08521400 


T 


0320*0 


08321450 


T 


0322J1 


08521500 


T 


0325*0 


0852160Q 


T 


0327J1 


08521700 


T 


0330*0 


08521800 


T 


0330*0 


08521900 


T 


0332*1 


08522000 


T 


0333*0 


08522100 


T 


0334*2 


08522200 


T 


0337*0 


08522300 


T 


0339*1 


08122400 


T 


034QI0 


SIZE* 0341 



• 
• 



PROCEDURE READATA(TYPE); 



START OF REL 



VALUF 

REAL 

BEGIN 

ARRAY 



type; 
type; 



DATA * 21C*3> 

COMPANION * 22C*3; 
INTEGER PT'R * 23* 

ENDATA * 24; 
INTEGER COL* 

COUNT* 

D> 
NuMROWS, 

Rf 
ROW, 

rowlength* 
t; 

BOOLEAN THISTYPe; 
ARRAY MATRlXt*]* 

MATRIXROWC*]* 
OATARQWC*]* 
C0MPRQW[*3; 
NAME N; 
LABEL NORMAL* 
REAL SUBROUTINE GETNEXT; 
BEGIN COMMENT GET NEXT ITEM FROM STACK* AND DO 
SOME ROUTINE HOUSEKEEPING OPERATIONS; 
P(*(P( .TYPE3+CQUNT) ); 

THISTYPE * (TYPE * O&TYPE 1 6 * 7 MO 3 ) , [61 13 ; 
GETNEXT «- POLISH 
ENO GETNEXT; 



08600000 

segment; disk 

08600100 
08600200 
08600300 
08600400 
08600500 
08600600 
08600700 
08600800 
08600900 
08601000 
08601100 
08601200 
08601300 
08601400 
08601500 
08601600 
08601700 
08601800 
08601900 
08602000 
08602100 
08602200 
08602300 
08602400 
08602500 
08602600 
08602700 
08602800 
08602900 



fcORDS 



T 0000*0 

ADDRESS * ©0595 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 0000*0 

T 000l»0 

T 0001*0 

T 0001*0 

T 0002*0 

T 0004*3 

T 0004*3 



• 
• 



t 1 



t 



3]]]); 

SKIP A 



COM) 



sb; 



• 






BOOLEAN SUBROUTINE DIMENSION* 

BEGIN COMMENT THUE FOR SINGLE DIMENSIONED (INCLUDES STRINGS);; 

STREAM<T«-POLlSH(XCH> 0# CDC)8a*0); 

BEGIN SI<-T; OI*t; SI*SI-16J SKIP 2 sb; 
IF SB THEN ELSE TALLY*1; T * TALLY; 

end stream; 

dimension * thistype or polish; 
end oimension; 
subroutine put; 
begin comment gets and stores next datum; 

IF CRx256 + D) = ENDATA THEN POL IShC ("48 )* 2b* COM); 
IF flATAROWsO THEN 

begin datarow <• *[data[r]3; 

comprow «. *[c0mpani0ncr33; 
end; 

stre am <a*t, [43 «5] ib* c comprow ct.c40 
begin si*b; si*si+2; skip 4 sb; 

if. sb then tally*i; a<-tally; 
end stream; 

if polish+thistype then p(("44)> 26* 
if thistype then 
begin comment stringjj 

stream(s«-idatarow[D]],n); 

BEGIN S-l+S* DS«-2 WDS; END; 

end else comment numerical stuff cor we are in trouble); 
p(Oatarowed3*Cn3><-); 

IF (D «■ D + THISTYPE + D2256 THEN 
BEGIN COMMENT ROW OVERFLOW; 

r ?= R + i; t := d 5= datarow :■»? o; 
end else t ♦ t+1; 
end put; 
subroutine exit; 

BEGIN COMMENT FUTZ UP PTR AND GO BACK TO THE REAL WQRlD; 

ptr «• r&dcctf3&t[9j39s93; 
polish(xit)^ 
end exit; 

comment**********start 
count «• type, c 1 « 61; 
r ♦ ptr.ccf3; d * ptr.eff3; t 
if not type then go to normal; 

DO BEGIN 

POLlSH(MATRlX «• GETNEXT); 

IF DIMENSION THEN 

BEGIN COL «■ THISTYPE + i; ROWLENGTH * MATRIX , t 8 8 10 3 1 

DO BEGIN 

N * [MATRIXICOL33; 

put; 

END UNTIL 
END ELSE BEGIN 
NUMROWS «• 
ROWLENGTH 
DO BEGIN 

MATRIXROW «• *[MATRlX[R0W3i; 
DO BEGIN 

N * [MATRIxROW[COL33; 

put; 
end until (col * col + 1 ) = r0nl.engthj 



OF code**********; 



<- PTR,[9?93; 



(COL * C0L+THISTYPE+1)=R0WLENGTH; 



MATRIX. [8H0]; 

* (*[MATRIXIR0W 



133) 



[88103; 

COL * 1* 



08603000 

08603100 

08603200 

08603300 

08603400 

08603500 

08603600 

08603700 

08603800 

08603900 

08604000 

08604100 

08604200 

08604300 

08604400 

08604500 

08604600 

08604700 

08604800 

08604900 

08605000 

08605100 

08605200 

08605300 

08605400 

08605500 

08605600 

08605700 

08605800 

08605900 

08606000 

08606100 

08606200 

08606300 

08606400 

08606500 

08606600 

08606700 

08606800 

08606900 

08607000 

08607100 

08607200 

08607300 

08607400 

08607500 

08607600 

08607700 

08607800 

08607900 

08608000 

08608100 

08608200 

08608300 

08608400 

08608500 

08608600 



T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

•Htt 

T 
T 

T 
T 

T 
T 



0005*1 
000680 

0006*0 
0007«3 
000883 
001080 
001081 
001110 
001181 
001210 
001280 
OOl 5 * i 
001681 
0018*0 
001981 
001981 
002183 

002350 
002480 

0024 8 1 
002611 

0026 8 2 
002780 
002881 
002980 
002980 
003082 
00328 3 
003381 
0036 8 1 
003880 
003881 
003980 
OO398O 
004181 
004182 

0041J3 
004183 

004683 

005082 
00518 1 

005111 

0052 » 2 
005480 
005781 
005781 
005881 
005980 
006183 
006281 
006383 
006680 
006680 

0068*0 
0068*0 
006980 
007080 







END UNTIL (ROW «■ ROW + 1 jaNUMRQWS; 

end; 

END UNTIL (COUNT «■ COUNT-l)sOI 

exit; 

NORMAL? 

DO BEGIN 

n <• getnext; put; 
end until (count ♦ count-d=o; 
exit; 
end readata; 



08608700 
08608800 
08608900 
08609000 
08609100 
08609200 
08609300 
08609400 
08609500 
08609600 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0072*1 
007452 

0074*2 
0076*3 
0078*0 
0078*0 
0078*0 
0081*0 
0083*1 
0084*0 



i 

i 



size* oo85 words 



procedure pasicinpuT(types); 



START OF REL 



• 

• 



VALUE TYPES; 


real types; 


BEGIN REAL 


RCN = +0* 




ALGQLREAP s 13, 




algolselect - u; 


ARRAY 


POT a 25C*3; 


INTEGER 


BSIZE* 




BUFF* 




CHAR* 




COL* 




COUNT, 




COUNTER, 




DECADES, 




E* 




ESIGN* 




NUMBER' 




NUMROWS, 




ROW* 




ROWLENGTH* 




sign; 


BOOtEAN 


GOTDIGIT* 




READSTMT* 




STOG* 




THISTYPEI 


ARRAY 


FIBC*!* 




MATRIXE*3* 




MATRIXROWC*]; 


NAME 


ADDRESS, 




FILX* 




POINTER, 




STRING s ADDRESS; 


LABEL 


LOOK* 




SIGNED* 




PASTPOINT* 




AT* 




EXPSIGNED» 




DECIMAL, 




ERROR' 




STRUNG* 



08700000 

segment; DISK 

08700100 

08700200 

08700300 

08700400 

08700500 

08700600 

08700700 

08700800 

08700900 

08701000 

08701100 

08701200 

08701300 

08701400 

08701500 

08701600 

08701700 

08701800 

08701900 

08702000 

08702100 

08702200 

08702250 

08702300 

08702400 

08702500 

08702600 

08702700 

08702800 

08702850 

08702900 

08703000 

08703100 

08703200 

08703300 

08703400 

08703500 

08703600 

08703700 

08703800 



T 0000*0 
ADDRESS « 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



00598 



• 



« i 






# 



QUQTEOSTRING* 
SETCQUNT* 

NORMAL* 
EXIT* 

dummylabel; 
real subroutine getnext; 
begin count *■ count-w 

pc+pointeR); pointer * 1 inx pointer; 

thistype *■ (types * o&types c 6 8 7 * 39 ] ) , [ 6 8 1 ] / 

getnext 4- polish 
END getnext; 

BOOLEAN SUBROUTINE DIMENSION/ 

BEGIN COMMENT TRUE FOR SINGLE DIMENSIONED (INCLUDES STRINGS);; 

STREAM(T<-POLlSH(XCH» 0* CDC)*A«.Q); 

BEGIN SI*T; DI<-T> SI*Si«16; SKIP 2 SB; 
IF SB THEN ELSE TALLY«-i; T *■ TALLY; 

END STREAM; 

dimension <■ thistype or polish; 
end dimension; 
SUBROUTINE checkpresence; 

BEGIN COMMENT CALL ALGOL READ INTRINSIC TO 
AWAIT TOP BUFFER BEING PRESENT; 
BSIZE <• POLISHCMKS* 0* l» FILX, ALGOLREAD); 
IF FlB[4],C8i4J=10 THEN 8SIZE ♦ 9 ELSE BSIZE * BSIZE-1J 
BSIZE «- BSIZEX8; BUFF «■ ( *F ILx ) , C CF 3 ; 
END CHECK PRESENCE BIT; 
SUBROUTINE READIT; 

POLISH(MkS, 0* 0, FILX* ALGOLReAD)/ 

subroutine setupandexit; 

BEGIN FIBC2l3»'BUFF&8SlZECi8*38»i03«n29l47»13J P(XIT); END; 
SUBROUTINE SCAN; 

BEGIN COMMENT GENERAL-PURPOSE SCANNER — CHARACTER AT A TIME; 
LOOK* IF BSIZE=0 THEN BEGIN READIT; CHECKPRESENCE; END; 

STREAM(I«--l>RUFF,N«-IF BSIHE<63 THEN BSIZE ELSE 63$STQG); 

BEGIN si<-buff; ci«-ci + stcg; GO TO deblank; 

comment switch on whether within string or not; 
gnc: tally*tauly+i; di«-lqc i; ds«-lit m o m ; 

di*di+6j ds*chr; go to exit; 
deblank! n(if sc*" " then jump out to gnc; 

TALLY*TALLY+i; SI»SI+1); 

exit* n*tally; buff*sij 
end stream; 

BSIZE *■ BSIZE-P(XCH); comment 

buff * polish; comment 

IF PCDtjPXO THEN COMMENT 

begin p(del); 

if (bislzeso) and gotdigit then p( w *'m else go to look; 

end; 

char *• polish; 
end scam routine; 

BOOLEAN SUBROUTINE TESTCOLLECt; COMMENT PUTS CURRENT CHAR 

INTO STRING AND UPDATES CHAR C0UNTER#ALS0 DETECTS OVERFLOW; 
BEGIN 

STREAMCCHAR* N * -COUNTER 5 =C0UNTeR + 1 * STRING);* 

BEGIN SI := LOC n; Si is si*i;% 
di := di+n; DS is chr;% 

end stream;* 



UPDATE COUNT; 
UPDATE POINTER; 
ONLY FOUND BLANKS; 



08703810 
08703820 
08703900 
08704000 
08704100 
08704200 
08704300 
08704400 
08704500 
08704600 
08704700 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



08704800 T 
08704900 T 
08705000 T 
08705100 T 
08705200 T 
08705300 T 
08705400 T 
08705500 T 
08705600 T 
08705700 T 
08705800 T 
08705900 T 
08705950 T 
08706000 T 
08706100 T 
08706200 T 
08706300 T 
08706310 T 
08706320 T 
08706400 T 
08706500 T 
08706600 T 
08706700 T 
08706800 T 
08706900 T 
08707000 T 
08707100 T 
08707200 T 
08707300 T 
08707400 T 
08707500 T 
08707600 T 
08707700 T 
08707800 T 
08707900 T 
08707920 T 
08707940 T 
08708000 T 
08708100 T 
08708110 T 
08708115 T 
08708120 T 
08708125 T 
08708130 T 
08708135 T 
08708140 T 



0000*0 
000080 
0000*0 
000080 
0000*0 

ooooso 

0001*0 

0002*1 

0004*0 

0006*3 

0006*3 

0007*1 

0008*0 

0008*0 

0009*3 

0010*3 

0012*0 

001281 

0013*0 

0013*1 

0014*0 

OOUtO 

00U*0 

0015*3 

0020*1 

0023*0 

0023*1 

0024*0 

0025*2 

0026*0 

0029*3 

0030*0 

0030*0 

0033*0 

0037*0 

0038*0 

0038*0 

0039*0 

0039*3 

0041*1 

0042*0 

0042*2 

0042*3 
0044*0 

0044*2 
0045*1 
0046*0 
0048*0 
0048*0 
0048*2 
0048*3 
0049*0 
0049*0 
0049*0 
0051*1 
0051*3 
0052*2 



i 
i 
i 







c 



TESTCOLLECT. 'sCOUNTER= 15;% 
END TESTCOUECm 
SUBROUTINE FREEREAO* 

BEGIN COMMENT READS AND STORES NEXT DATUM* DOING 
CONVERSIONS, HANDLES STRINGS AND 
ACCEPTS A VARIETY OF FORMATS; 



APPROPRIATE 
NUMBERS* AND 



«. GOTDIGIT 
TO EXIT; 

to strung; 



* NUMBER * STOG * 0; SCAN; 



or char*"*" then scan; 
scan; 



• 



THEN SCAN; 



DECADES * E ♦ ESIGN 

IF CHAR*"*" THEN GQ 

IF THISTYPE THEN GO 

GOTDIGIT «■ 1; 

IF (SIGN *• CHARs"-") OR CHAR = " + ' 

IF CHAR>9 THEN GO TO DECIMAL; 

DO BEGIN NUMBER «- 10*NUMBER+CHaR; 

END UNTIL CHAR>9; 
IF CHARs"," THEN 
BEGIN SCAN; 
PASTPOINTI! WHILE CHAR<<9 DO 

BEGIN NUMBER «• IQxNUMBER+cHAR; 

decades «■ decades + i; scan; 
end end; 

if chars"?'" or char*"e" then 
at? : begin scan; 

if cesign * char*"-") or char****" or charts" 
if ce «■ char)>9 then go tq error; scan; 

WHILE CHAR<9 DO BEGIN E * IOxE+CHAR; SCAN; END! 

if esign then e ♦ -e; 
end; 

while charx"*" do scan; 
pcnumbep* e-decades* pot c absc p( dup ) ) j * xch); 
if p(dup)-0 then pcdel* del) 

else if p<0 then pc/) else pc*); 
if sign then p(chs); p(eaddress3* o; 
go to exit; 
decimal* 5 if char*"," then begin scan; 

if char<9 then go to pastpqint else go to error; eno; 

NUMBER «- i; 

IF CHAR="^" OR CHAR*"E" THEN Go TO AT; 
ERROR! COMMENT ERROR TERMINATE - INVALID INPUT DATUM;% 
POLlSHCC-41)* 26* COM)U 

strung*! comment collect string item;% 
counter!=-cstqg»=1);% 

stream(string); ds:*16 lit" "; % blank string 
if char =*"*" then go quotedstrlng; * 
while (char neq " " and char ne« "»" 

DO IF TESTCOLLECT THEN GO ERROR ELSE 

go to setcount;* 

QUOTEDSTRlNG! * 

SCA!«j; IF CHARs""" THEN GO SETCOUNT;% 

IF TESTCOLLECT THEN GO ERROR ELSE GO 

COMMENT CONVERT COUNTER TO COLLATING 
SETCOUNT! 

IF COUNTER LSS THEN GO ERROR % NULL STRING 

ELSE IF (COUNTERl-COUNTER-5) LSS THEN COUNTER : cCQUNTER+20;* 

COMMENT PUT IN CHAR COUNT REQUIRED BY BASIC STrjnGVARBJ X 

STREAM (COUNTER* STRING);* 

BEGIN SI«=LOC STRING; S I ! =" S I » 1 ; 

DissQi+is; dsjschr;% 



) 



scan;% 



ouotedstringix 
sequence;! 



08708145 
08708150 
08708200 

08708300 
08708400 
08708500 
08708600 
08708700 
08708800 
08708850 
08708900 
08709000 

08709100 
08709200 
08709300 
08709400 
08709500 
08709600 
08709700 
08709800 
08709900 
08710000 
08710100 
08710200 
08710300 
08710400 
08710500 
08710600 
08710700 
08710800 
08710900 
08711000 
08711100 
08711200 
08711300 
08711400 
08711500 
08711600 
087U610 
08711700 
08711800 
08711900 
087|2000 
08712100 
08712200 
08712210 
08712300 
08712400 
08712500 
08712600 
08712700 
08712800 
08712810 
08712900 
08712920 
08713000 
08713010 



T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0052*3 
005313 
005410 

0054*0 
0054*0 

0054 »0 
0054*0 
0058*0 

0059*1 
0060* 1 
0061*0 
0066*0 

0067*1 

0070*0 

0071*1 

0072*0 

0074*0 

0075*1 

0077*0 

0079*0 

0079*2 

0081*1 

0083*0 

0088*0 

009l!0 

0095*2 

0097*1 

0097*1 

0100*2 

0102*2 

0104*1 

0106*3 

0108*1 

0108*3 

0111*0 

0112*3 

0113*2 

0116*0 

0116*0 

0117*0 

0117*0 

0118*2 

0121*3 

0123*0 

0124*1 

0128*2 

0129*0 

0129*0 

0131*1 

0133*0 

0133*0 

0133*0 

0133*3 

0137*3 

0137*3 

0138*3 

0139*1 



• 



• 
• 



# 



*. i 



• « 



end stream;* 

Q0TBIGITI«1J 



STOG!sO|% 



23. 



IF CHAR NEQ »*" THEN DO SCAN UNTIL CHAR»">"JX 
EXIT: 5 
END FREE FIELD READ ROUTINE; 

COUNT «■ TYPES, C1I63J REAOSTMT * TYPES, C46 « 1 3 * 

FIIX * *CPOlNTER «■ 1 INX ( CRCW ]&RCW E FTC 3 ) ) I 

FILXCNOI 43 * *C1 INX POINTER)) FIB «- FILXCNOT 

POINTER ♦ 2 INX POINTERS 

IF FI8[53,C43!2]*2 THEN PCMKS> 0, 2* FILX, 1* ALGQLSELECT ) i 

IF CE*»FIBC4].C8»4])«10 DR E = 13 THEN FIBC203**0 

ELSE IF FIBC20] NEQ THEN P(FILX#8» H#COM>) 
IF CBUFF «■ CE * FIBC213)»C30:i83) « 

THEN CHECKPRESENCE ELSE BSI7.E «■ E» C 18 : 103 5 
IF NOT TYPES THEN GO TO NORMAL; 
BEGIN 

POLISHCMATRIX * GETNEXT); 
IF DIMENSION THEN 

BEGIN COL «• THISTYPE + i; ROWLENGTH «- MATRIX, C8I103; 
DO BEGIN 

address <• [matrixccol33* 
freeread; 

END UNTIL (COL * COL+THISTYPE+1 )sROWLENGTH* 



no 



MATRIX. C8* 103; 
* (*[MATRIXCROW 



END ELSE BEGIN 
NUMROWS «• 
ROWLENGTH 
00 BEGIN 

matrixrqw 

DO BEGIN 

ADDRESS «■ 

freeread; 

END UNTIL (COL 
UNTIL CROW 



* 1J]),C 8 I 10 3* 

♦ *[MATRIXCR0W33; COL * 



i; 



[MATRlXROwrcOI-33; 



END 

end; 

END UNTIL COUNT=o; 

setupandexit; 

NORMAL? 

DO BEGIN 

address «■ getnext; 
freeread; 

END UNTIL COuNT=0; 
SETUPANDEXIT; 
END BASIC INPUT ROUTINE; 



* col+i)sROwlength; 

ROW+l)xNUMROWS; 



08713020 
08713100 

08713110 
08713200 
08713300 
08713400 
08713500 
08713510 
08713520 
08713600 
08713610 
08713620 
08713700 
08713710 
08713800 
08713900 
08714000 
08714100 
08714200 
08714300 
08714400 
08714500 
08714600 
08714700 
08714800 
08714900 
08715000 
08715100 
01715200 
08715300 
08715400 
08715500 
08715600 
08715700 
08715800 
08715900 
08716000 
08716100 
08716200 
08716300 
08716400 
08716490 
08716500 



0139*3 

0140»0 

014U2 
0145*1 
0145* 1 
0146*1 
0155*2 
0158*0 
0162*1 
0163*2 
0167*0 
0171*0 
0174*3 
0176*3 
0180*3 
0181*2 
0181*2 
0183*2 
0185*0 
0188*1 
0188*1 
0189*1 
0190*0 
0192*3 
0193*1 
0194*3 
0197*0 
0197*0 
0199*0 
0199*0 
0200*0 
0201*0 
0203*1 
0205*2 
0205*2 
0206*3 
0208*0 
0208*0 
0208*0 
0209*2 
0211*0 
0212*1 
0213*0 



• 



SIZE* 0214 WORDS 



%*********************************************************************** 
PROCEDURE MATRIXOIDDLERCA, B> C* TYPE);* MAT ARITH INTRINSIC 

START OF REL 

RESULTANT MOM 

ARG 1 MOM OR SCALAR VALUE 

ARG 2. MOM 

8 C * 3 * cc*3; 



VALUE 



% 

% 



A, 
8*. 

c; % 

ARRAY AC*3* 
INTEGER TYPE; 
£*******************************#****************************** ********* 



08800000 
08800050 
SEGMENT; DISK 
08800100 
08800110 
08800120 
08800200 
08800300 
08800310 



T 0000*0 
T 0000*0 
ADDRESS m 



T 
T 

T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



00606 






BEGIN REAL 
INTEGER I# 



SCALE = Bj 



• 



• 



* * 



THEN GO ERROR! % 



LASTI, 
LASTj; 
ARRAY ARQWC*3, 
BROW£*]/ 

criwc*]; 
boolean single! 
label error* 

DI^ERR, X% 

CHKSl* 

CHKSIZE* 

NORMAL* 
SCALEFACTOR! 

DEFINE SF ■ C3510]#;% 
BOOLEAN SUBROUTINE DIMENSION! X 

BEGIN COMMENT TRUE FOR SINGLY-DIMENSIONED MATRIX!; 

STREAM(T:=P<XCH> 0» CDC)*A*sO); 
BEGIN SI*=T! DI « =T; Si:*SI-l6! SKIP 2 SB',%% 

IF SB THEN ELSE TALLYS-1! T»=TALLY! 
END STREAM; 

DIMENSION * = POLISH! 
END DIMENSION! 
COMMENT *********** START OF CODE 
I := Jis \i POLISHCCRQW * = C)!X 
IF (SINGLE 8* DIMENSION) THEN 
BEGIN COMMENT ROW VECTOR CAS£!% 

LASTI ?* 2! LASTJ !» C.SF!% 
IF NOT POLISHCAROW :»A# DIMENSION) 
IF TYPE * 2 THEN GO CHKSIJ X 
IF POLISHCBROw J* R, DIMENSION) THEN 
IF LASTJ s BROW.SF THEN GO CHKSI!% 
ERROR: COMMENT NQN CONFORMAL ARGUMENTS; 

PQLISHC(-50), 26, COM)! X 
CHKSIi COMMENT CHECK DIMESION BOUNDS; 

IF LASTJ GTR A.SF THEN 
DIMERRS COMMENT DIMESION SIZE ERROR! 
POLISHCC-7.2)* 26# COM)!X 
END ROW VECTOR CASE ELSE 
BEGIN COMMENT MATRIX CASE!% 

LASTI := CSF! LASTJ ** C * t C [ 1 3 3 ) , SF! % 
IF POLISHCA, DIMENSION) THEN GO £RROR!X 
IF TYPE ■ 2 THEN GO CHK5IZ£;X 
IF NOT POLlSH(B*DIMENSION) THEN 
IF LASTI * B*SF THEN 

IF LASTJ = (*CB[133),SF THEN GO CHKSIZE! 
GO TO ERRQRU 
CHKSIZEJ COMMENT CHEK DIMENSION BOuNoS;x 
IF LASTI GTR A,SF OR 
LASTJ GTR <*CAU3]) f [8 
GO TO DIMERR! XX 
END MATRIX CASE;* 

IF TYPE - 2 THEN GO TO 
NORMAL* * 
DO BEGIN 

IF NOT SINGLE THEN 



* ■*; 



103 THEN XX 



SCALEFACTOR! XX 



08800400 
08800500 
08800600 
08800700 
08800800 
08800900 
08801000 
08801100 
08801200 
0S801300 
08801350 
08801355 

08801360 

08801400 

08801500 

08801600 

08801700 

08801800 

08801900 

08802000 

08802100 

08802200 

08802300 

08802400 

08802500 

08802600 

08802700 

08802800 

08802850 

08802900 

08803000 

08803050 

08803100 

08803200 

08803300 

08803310 

08803400 

08803500 

08803510 

08803600 

08803610 

08803700 

08803800 

08803900 

08804000 

08804100 

08804200 

08804300 

08804310 

01804400 

08804500 

08804600 

08804700 

08804800 

08804900 

08805000 

08805100 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 

oooo'o 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0000*0 

0001*0 

0001*0 

0002*3 

0003*3 

0005*0 

0005*1 

0005*2 

0005*3 

0005*3 

0010*1 

0011*2 

0012*0 

0014*1 

0016*2 

0017*3 

0020*0 

0022*2 

0022*2 

0023*2 

0023*2 

0025*0 

0025*2 

0026*2 

0026*2 

0027*0 

0030*1 

0032*3 

0034*0 

0036*1 

0038*1 

0041*0 

0041*2 

004i*2 

0043*0 

0045*0 

0045*3 

0045*3 

0047*0 

0047*0 

0047*0 



« 






BEGIN AROW 8= * C AC 1 1 3 ^ BROW U *C8C 13 3i 

crow s= *cctni; J := i; 

end; 

if type=o then 

*: DO AROWCJ] 5= BROWCj3+P(CROWtJ3# XCH) 
UNTIL (J := J+1)=LASTJ 
ELSE 
** DO AROWCJ1 := CR0WCJ3-P(BR0wU3> XCH) 
UNTIL (J » = J+l)=LASTj; 

COMMENT NOTE FANCY WAY OF SAYING A«B*C; 
END UNTIL CI I' I+1)=LASTU 
P ( X I T > ' 
SCALEFACTOR5 i 
DO BEGIN 

IF NOT SINSLE THEN 
BEGIN AROW * = *UU3]; CROW := *tctI33; END; XX 

IF SCALE = 1 THEN XX 
BEGINS STREAM(F8=CCR0WC1]],N:=LASTJ'1# 

TJ*P(OUP).[36J63,OES ** CAROW[133); XX 
BEGIN SI»sF; T(DS:*32 WOS; DS*=32 WDS); XX 

ds is n wos; XX 
end stream; %% 
end ELSE XX 
BEGIN J :* i; XX 
:: DO AROWCJ3 * = CRQWU3xP(SCALE* NOP* XCH) XX 

UNTIL CJ := J+1)=LASTJJ XX 

end; XX 

END UNTIL (I 5= I + D-LASTi; XX 

END MATRIX DIDDLER; XX 



08805200 
08805300 
08805400 
08805500 
08805600 
08805700 
08805800 
08805900 
08806000 
08806100 
08806200 
08806300 
08806400 
08806500 
08806600 
08806700 
08806800 
08806900 
08807000 
08807100 
08807200 
08807300 
08807400 
08807500 
08807600 
08807700 
08807800 
08807900 
08808000 



T 0047*2 

T 0050*2 

T 0052*2 

T 005252 

T 0053*1 

T 0055*3 

T 0057*3 

T 0058*3 

T 006i*3 

T 00641.3 

T 006^*3 

T 0067*0 

T 0067*1 

T 0067*1 

T 0068*0 

T 0068*2 

T 0071*2 

T 0072*1 

T 0074*1 

T 0075*3 

T 0077*1 

T 0077*3 

T 0078*0 

T 0078*0 

T 0079*1 

T 0081*3 

T 0084*3 

T 0084*3 

T 0087*0 

SIZE* 0088 WORDS 



i 

i 

i 
f 

i 
i 
t 
i 
« 



x*** **************************** ************************** 
PROCEDURE TRANSPOSED, B); XXXX MATRIX TRANSPOSE XXXX 






VALUE A#B; XXXX INTRINSIC 

ARRAY AC*], X MOM DESc FOR RESULTANT MATRIX OR 
Be*]; X MOM DESC FOR ARGUMENT 



ROW VECTOR 



START OF REL 



BC*3; % MOM DtSC FUR ARGUMENT " " 

X * * * ****************************************************** 
BEGIN LABEL ERR5Q* ERR72, NORMAL* PLACE* TRaNSPOSEI T; X 

INTEGER I*J*LASTI*LASTJ;X 

ARRAY R0Wt*3>X 

DEFINE SF = t3*l03#U 

COMMENT THERE ARE THREE SPECIES OF MATRIX TRANSPOSITION; 

X 1. ROW INTO COLUMN 

X 2. COLUMN INTO ROW 

X 3. MATRIX INTO MATRIX 

X IN THIS CASE TRANSPOSITION MAY BE DONE IN PLACE 

COMMENT TRANPOSITION WILL BE PERFORMED WHEN THE RESULTANT 

MATRIX DIMENSIONS ARE LARGE ENOUGH TO ACCOMMODATE 

THE DIMENSIONS OF THE ARGUMENT MATRlX»EVEN THO THE MATRICES 

MAY NOT BE MATHEMATICALLY CONFORMABLE; X 

BOOLEAN SUBROUTINE DIMENSION; 

BEGIN COMMENT TRUE IF SINGLY DIMENSIONED;; 



08900000 
08900010 

segment; DISK 

08900100 
08900200 
08900210 
08900220 
08900300 
08900320 
08900400 
08900^05 
08900420 
08900430 
08900440 
08900450 
08900500 
08900501 
08900502 
08900503 
08900504 
08900505 
08900510 
08900515 



T 0000*0 
T 0000*0 
ADDRESS m 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0001*0 



00609 



c 



ST 

EN 
DI 

end; 
********** 

PCLlSHf 

BEGIN C 

PO 

BE 

ER 

EN 

If 

IF 

I! 

GO 

END 1 D 

BEGIN C 

PO 

IF 

IF 

* 5 DO 

PO 

END 2 

NORMAL! 

IF 

OR 

I? 

: J DO 

TPANSPO 

: i 



REAM(TS=POL 
GIN SlJaT; 
IF SB TH 

d stream; 

mens i on *« polish* 



ish(xch» 0' coc)5a5«0); 
oi*»t; sii«si-16i skip 2 sb; 
en else tauly»«1i totally; 



PLACES s 
: t 



EN 
PO 
IF 
DO 



END 



EN 
TRA 



* STA 

a); I 

OMMEN 

LISHC 

GIN E 

R72: 

ERR 

CLAS 

(LAS 

»U R 

TRAN 

IM RE 

OMMEN 

LISHC 

C*[A 

(LAS 

POLI 

LISHC 

I M RE 

(LAS 
(LAS 

= i; I 

BEG I 

SEITJ 

DO 

UNT 

LISHC 

LAST 

BEGI 

DO 

D UNT 
NSPOS 



RT OF 
F DIME 
T 1-DI 
B)* IF 
RR5Q*P 
P((-72 

ors;x 

TI SsC* 
TJ*=B, 
0W**A; 

SPOSEI 
SULTAN 
T 2-01 
B); IF 

cm). 

TJ*=B, 
SH(BCJ 
XIT)U 
SULTAN 

Tj:s8, 
F A.CF 
N ROWi 

Jl-l; 

P(*EB 
IL CI 

xid; 

1*2 TH 
N ROW 

PCROW 
UNTIL 
IL (I 
E ROUT 



CODE ************* 

NSION THENX 

M RESULTANT, ALLOW 2, ONLY; 

DIMENSION THEN % ERROR - ROW 
((-50)*26#C0M);% 
>*26>C0M);S 



TO ROW 



CBCUn.SF) NEQ 2 THEN GO ERR50;% 

SF) GTR A.SF THEN GO ERR72;% 

% 

t;x 

T ELSE 

M RESULTANT, ALLOW 1. OR 3.; 

NOT DIMENSION THfN GO NORMAL** 
SF NEQ 2 THEN GO ERR50;% 
SF) GTR A.SF THEN GO ERR72;% 
]**CAtJ]3»l»C0C»STD> UNTIL ( J J *J+1 )-LAST JJ % 



lit 



■CBC1]]),SF) GTR A.SF 
SF) GTR(*[A[133).SF THEN 
F3=S.tFF3 THEN GO PLACE; 

= * r. a c 1 1 3 ; % 



% 

[J33, I , COC* 
<■ I + D-LASTI1 



GO ERR72;« 

% TRN IN PLACE 



[R0WU33* O UNTIL CJ ♦ J+1)*LASTJ; 



EN POLISH(XIT); 

♦ *cA[i]3; j ♦ 1+1; 

CJ3, *[ACJ33* 1/ CDC, 
(J *• j+l)«LASTJ* 
♦ I + n-lASTl-U 

ine; 



DUP, LODf [ROWCJ33, *• , ♦) 



08900520 
08900525 
08900530 
08900535 
08900540 
08900545 
08900549 
08900550 
08900555 
08900560 
08900600 
08900605 
08900607 
08900610 
08900630 
08900650 
08900700 
08900710 
08900750 
08900800 
08900810 
08900830 
08900850 
08900870 
08900890 
08900900 
08901000 
08901010 
08901020 
08901100 
08901110 
08901200 
08901300 
08901400 
08901500 
08901600 
08901700 
08901800 
08901900 
08902000 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SIZE 



000l?0 
000213 
0003*3 
0005*0 
0005H 
0005*2 
0005*3 
0005*3 
0009*0 

0009*2 
OQU»0 
0012*2 
0013*2 
0013*2 
0016*1 
0019*2 
0021*1 
0021*3 
0021*3 
0022*1 
0024*2 
0026*3 
0030*0 
0034*1 
0034*2 
0034*2 
0034*2 
0036*1 
0041*2 
0045*0 
0046*1 
0047*0 
005111 

0053*2 
0053*3 
0055*2 
0058*2 
006211 

0064*2 
0067*1 
* 0068 



• 



WORDS 



%****** ******************************************************** ********* 
PROCEDURE MATRIXMULTIPLY(A,8,C); %%% MATRIX MULTIPLICATION XXX 

START OF REL 
VALUE A,8»Ci %%% INTRINSIC %%% 

ARRAY A[*3, % RESULTANT MAT OR ROW VECTOR MOM 
BC* 3* * ARG-1 " 

C[*3; % ARG-2 " 

%*********************************************************************** 
BEGIN 

LABEL ERR50>ERR72,D0TPR0DUCT*CR0SSPr0DUCT;% 
ARRAY AR0W[*3, % 
BR0Wt*3> X 



09000000 
09000100 
SEGMENT! DISK 
09000200 
09000300 
09000400 
09000500 
09000600 
09000700 
09000800 
09000900 
09001000 



T 0000*0 
T 0000*0 
ADDRESS v 



T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 

0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



00612 



» i 



# 



I 




L 

S 

M 
REAL 
BEGIN 

S 

8 

E 


END C 

BOOLE 


COMME 
L 
L 
G 

MMMJ 
I 

ERS50 
P 
! 

ERR72 
P 
I 

** D 



s 



E 

P 
RRM} 

A 
MRM? 

I 
L 
G 

MMRS 
I 
L 
C 

CROSS 

D 



CROWE 

NTEGER I»J 

EFINE SF a 

EFlNE SETT 

SI s*Si 

ABEL RRM,M 
WITCH SWL 
RM,MMR#MMM 
SUBROUTINE 
COMMENT S 
TREAMCSWVA 
Eft IN OI«*L 
SETTOS 
NO STREAM! 
IMENSIONSs 

IMENSIONS; 
AN SUBROUT 
IMERRJ=(LA 
\'T ******* 
ASTH»8.SF 
ASTKJsCtSF 
TO SWLCD 
COMMENT At 
F LASTK Ne 
* COMMENT 
0LlSH(C-50 
F DIMERR T 
: COMMENT 
OLlSHCC-7;? 
F LASTK«2 
BEGIN 

BROW?* 

OTPROOUCTt 

i DO BEG 

K 

J ? o. 

U 

P 

END UN 

Hd UNTIL ( 

clishcxit) 
comment ac 
row*=a; 
comment a( 
f lastk ne 

ASTU = 2J I 
G TO OOTPR 
COMMENT AC 
F BROW.SF 
ASTJ8=LAST 
Rf)W»«CJ% 
PRODUCT: ? 

BEGIN 

AROWJs 

x;=pol 

: DO PCX 
UNTILC 



»K,LA 
[811 
OSAVE 
-161 
RM,MM 
:=ERR 

'dime 

ETS 8 



STI/L 

0]#> 

BITCS 

skip 

R,MMM 
50*RR 



NSION 
IT IN 
L«=OSAl»-C 
VALJ 
TCA1) 



OC sw 

AVEBI 



-POLI 
% 

INE D 
STI G 
*** S 
; LAS 
; ARO 
IMENS 
A1>A2 
Q BRQ 
NON-C 
)»26» 
HEN 
RESUL 
)>26> 
THEN 



snn 

IMERR 

TR A, 

TART 

Tj: = C 

W?s*[ 

IONS] 

)*BCB 

W,SF 

ONFQR 

COM)' 

TANT 
COM); 
Go CR 



*EBCl3j; A 

IN 

**1* POLIS 

PC*CCCK3 

NTIL CKJsK 

OLISHC CAR 

TIL (Ji*J+ 

I$=I+1)=LA 

i% 
A1)=BCB1 )* 

A1»A2)*BCB 
Q CBROW5=B 

f dimerr t 
oduct;x 

Al*A2)sB<B 

NEQ 2 THEN 
k; IF DIME 



♦CACI3]; J 
ISHC*CBCI3 
>CROW[J]>M 
JS=J+l)aLA 



astj>lastkj* 

X 9 8R0W#;% 

ETTOSAVEBIT1)«SII*SETTOSAVEBITW 

2 SB; IF SB THEN DS**SeT ELSE DS:=RESET#S 

i % 

M»ERR72'ERR72#eR'R50». 

C * 

SWVAL TO INDICATE MAT;% 
ACO]3*Bll*tBC03]#Cl»*CCtO]3)JX 
S'KTP45DBj% 
I SETTOSAVCBIT(Bl); SETTOSAVEBIT CC i) ; 



SF) OR CLASTJ gTR AROW,SF);X 

of CODE *************; 

CRQW:*»*[Ctl33).SF; % 

ACIIal]]; BROWi**CBC13JJ% 

}% 

1>B2)*CCC1>C2);% 

THEN 

MAL ARGUMENT MATRICES** 

% 

BOUNDS TOO SMALL - DIM ERR;% 

% 

OSSPRODUCT ELSE GO DOTPROOUCTn 

ROW S**CAC 1 3 3;% 



Hcom 

]»J*COC>BROW|[K]#MUl.#ADD> 

+ d=slastk;s 

QW[jn# STD5;« 
l)*LASTsi;« 

sti;x 

ccci/C2);« 

i)*ccci»c2);% 

).SF THEN GO ERR50; % 
HEN GO TO ERR72>'% 

i»d*cccd;% 

GO TO ERRbOS% 
RR THEN GO TO ERR72;* 



]*l#COC)/% 

ul#[arow[jj3#std> 
stj;% 



0900U00 
09001200 
09001300 
09001400 
09001500 
09001600 
09001700 
09001800 
09001900 
09002000 
09002100 
09002200 
09002300 
09102400 
09002500 
09002600 
09002610 
09002620 
09802700 
09002710 
09002800 
09002900 
09(503000 
09003100 
09003200 
09903300 
09003400 
09003600 
0900370Q 
09003800 
09004000 
09004100 
09004200 
09004300 
09004400 
09004500 
09004600 
09004700 
09004800 
09004900 
09005000 
09005100 
09005200 
09005400 
09005700 
09905800 
09005900 
09006100 
09006200 
09006300 
09006600 
09006700 
09006800 
09006900 
09007000 
09@07100 
09007200 



0000*0 
000010 
QQOO*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0001*0 
0001*0 
0003*2 
0004*0 
0010*0 
0010*1 
0010*2 
0010*3 
0011*0 
0014*3 
0014*3 
0021*0 
0025*2 
003113 
0031*3 
0033*1 
0033*3 
0034*3 
0036*0 
0036*2 
00 37*2 
0039*1 
0040*0 
0042*2 
0043* 1 
0044*0 
0045*0 
0047*1 
0049*2 
0050*1 
0052*2 
005413 
0055*0 
0055*0 
0056*0 
0056*0 
0058*2 
0060*3 
0061*1 
0061*1 
0063*1 
0065*3 
0066*3 
0066*3 
0067*0 
0069*0 
0070*3 
0073*0 



END UNTlL(I*»I+l)«LASTi;X 

end matrixmultiply;* 



09007300 
09007400 



T 
T 

SIZE* 



0075*1 
0077J2 



0078 WORDS 



• 
• 



PROCEDURE INVERTCA* 8)** 



START OF REL 



VALUE A, B; 
ARRAY AC*3* 
BEGIN REAL 

DEFINE 
INTEGER 



8C* 
BIG* 
DIAG 

EPS 

It 

II* 
J* 
K. 
K2» 
L* 
N* 
ND 
REAL BLOC 
BLOC 
ARRAY AROW 
COPY 
PLAC 
DEFINE MOVE 
SUBROUTINE SWA 
BEGINISTREAMCA 
BEGIN Sl<- 
SI*B 
SI«-C 
END END SWAP 
JSTREAM(T 
BEGIN SI! 
IF S 
BEGI 

END 

TJsT 

END STREA 

IF POLISH 

IF (N *■ A 

Nl * CN «■ 

IF A.tFF] 

BEGIN IF 

THEN PO 

IF N 

FOR 1*1 



3; 
= big; 

= COMMENT 



10P-13J o.ooooooooooooi#; 



KCOUNT 

KROUTI 

C*3* 

C * 3 * 

EHQLDE 

WORDS 

PROWSi 

**CAtI 

a; mo 
; di* 

OPY? 

RQWSJ 

*=CACO 

«t; di 

B THEN 

N Sps 

IF SB 

ELSE T 

ally; 

m; 

THEN 

•C8J10 

NM)* 

*B,[FF 

B.C8U 

LISH(( 

1=0 TH 

STEP 

STREA 

BEGIN 



ER m 
NE = 



16* 
5; 



R C * 3 ; 

* NHDS* 

33*B**[A 

vewords; 
a; move 
dj>b; m 

33«T1J»C 

j*t; sis 
ti; di *= 

THEN EL 
ALLYl=i; 



32 WDS; DS«-32WDS); DS*N WQS#; 
CK2]]#N*N+l»Nl*P(DUP)f t36i6]#C0PY)i 

words; 
ovewords; 

B[033); 

■51*16; SKIP 2 sb; 

TU SlJaSl-16; SKIP 2 sb; 
SE TALLY«*U 



P0LISHCC 

1; 

3 THEN 
03/N+l 
-50)* 26 
EN P(*CB 
1 UNTIL 
M(N* Nl* 
SI*S* S 



end; 

IF N*0 TH 
POLISHC *t 

BL0CKC0UN 

polishcmk 



EN 

AC133* 1* CDC* 

TER <■ BLOCKCOU 
S* CPLACEHOLDE 



-50)* 26* COM); 

133).[8?103 THEN P((*54), 26* COM); 



R <*CBEl33),t8JlO]*N+l 

» com); 

ttn» 1* COC* *CA[133* I* CDC* O ELSE 

N DO 

PCDUP), [36?63* S**tBtl33# D**C AC 1 3 3 )# 

i«-si+s; di*o; 01*01+8; movewords; end; 



DUP* LOD* 1* XCH* /* XCH* ** XIT)J 
NTER+i; 
R[P33* N + l* 1* 1* 0* BLOCKROUTINE); 



09 
SEGMENT 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 

09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 
09 



100000 
; DISK 
100100 
J00200 
100300 

100400 
100500 
100600 
100700 
100800 
100900 
101000 
iOllOO 
101200 
101300 
101400 
101500 
101600 
101700 
101800 
101900 
102000 
102100 
102200 
102300 
102400 
102500 
102505 
102510 
102515 
102520 
102525 
102530 
102535 
102540 
102545 
102600 
102700 
102800 
102900 
103000 
103100 
103200 
103300 
103400 
103500 
103600 
103700 
103800 
103900 



T 0000 
ADDRESS 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 



0000 
0000 

0000 

0000 

0000 

0000 
0000 

0000 

0000 

0000 

0000 

0000 
0000 

0000 

0000 
0000 

0000 
0000 
0000 

0000 

0001 
0005 
0007 

0009 

0011 

0012 
0016 
0017 

0018 

0019 
0020 
0020 
0021 
0021 

0022 
0027 
0029 
0031 
0035 
0038 
0042 
0044 
0047 
0052 
0052 
005 3 
0056 
0058 



SO 

s 

»0 
JO 
JO 
'0 
JO 
JO 
JO 
JO 
»0 
JO 
JO 

JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
JO 
«0 
JO 

Jl 

J2 
JO 
J3 
J3 

»1 
Jl 
II 
J3 
JO 
Jl 
J3 
Jl 
J2 
*3 
J3 

n 

ji 

JO 
JO 

Jl 
Jl 

JO 

»3 

JO 



00615 



• 
• 
• 






BLOCKCOUNTER ♦ BLOCKCOUNTER+i; 

POLlSH(MKS> CC0PYCP33, N + 1 , 1 , 1 , 1, 8L0CKR0UTINE ) ) 



* G* 
DO 

polishco); 

II DO 

CQC* AROWtKJ* 



SSP, DUP)>BIG THEN 

O else pcded; 



■<% NEARLY 



• 



COMMENT REDUCE THE MATRIX BY ROW PIvOTS TO TRI-DIAGONAL 
FOR 1*1 STEP 1 UNTIL N DO 
BEGIN II * (K2 * I)-i; BIG 
FOR J* I STEP 1 UNTIL N 
BEGIN AROW * *C AC J3 3 * 

FOR K*l STEP 1 UNTIL 

POLISH(*EA[K]3, \p COC* AROWCK3*. x, »). 
POLISHCAROWCI^ + ); 
IF POLISHCCAROWCIH* SND# 
POLISHC.BIG' «■* J* ,K2* 

end; 

if bigseps then pqlishc ( -57 ) » 26# com)/ 

if (placeholder[i3 * k2)*j then swaprows; 

diag «■ polishccarow «• *cau33)> i* coc>* 

for j«-i + l step 1 until n do 

begin pqlish(o); 

FOR K*-l STEP 1 UNTIL II DO 

POLlSH(*CACK]], J, COO ARQWCK3* x, *j; 
POLISHCAROWCJ3' + > DlAG* /* tAROW[Jl]# *•}) 

end end; 

polishcio* com); comment return copy array; 
comment invert lower triangular matrix; 
for 1*1 step 1 until n do 
begin ii * i-i; diag * polishccarow «• *caci33)> i* cc 

FOR J*l STEP 1 UNTIL II Dq 
BEGIN POLISH(O); 

FOR K*J STEP 1 UNTIL II DO 

P0LISHC*CA[K33, J# COO AROWtK]* x, *); 

POLlSH(t)lAG^ /f CAROwtJ]]* * ) ; 

end; 

arowcjj * 1,0/diaqj 
end; 

COMMENT INVERT UPPER TRIANGULAR MATRIX; 
FOR I*N1 STEP -1 UNTIL 1 DO 
BEGIN II «• I + U AROW * *CACM]J 
FOR J*N STEP -1 UNTIL II DO 
BEGIN L * J-i; PQLISHCO); 

FOR K*II STEP 1 UNTIL L DO 

POLlSH(*CAi;K]], J, COC AR0W[K3> x, -); 

pqlishcarqwcj3, chs* + # carqhu33* *); 
end end; 
comment multiply upper and lower halves to produce inverse; 

FOR 1*1 STEP 1 UNTIL Nl DO 
BEGIN AROW * *CA[I]3; 

FOR J*l STEP 1 UNTIL N DO 

BEGIN IF (K2 * J)SI THEN K2 * I + W POLlSHCO); 
FOR K*K2 STEP 1 UNTIL N DO 

POLISHOCACK]], J» COO AROW[K3# x, +); 

if ijj then p0lish(ar0w[j3* + >j 
p0lish(car0wcu33^ * ) ; 
end end; 
comment exchange column elements to absolve row pivoting; 
for j<-n step -1 until 1 do 
if ci «• placeholders >*j then 
for km step 1 until n do 





09104000 


T 


0060M 




09104100 


T 


006112 


m; 


09104200 


T 


006313 




09104300 


T 


0063*3 




09104400 


T 


0065<0 




09104500 


T 


0067*2 




09104600 


T 


006910 




09104700 


T 


0070*2 




09104800 


T 


007£»0 




09104900 


T 


0076*2 




09105000 


T 


0077»1 




09105100 


T 


0079»0 




09105200 


T 


0081*2 


SINGULAR 


09105300 


T 


0083*3 




09105400 


T 


0086*0 




09105500 


T 


0089*0 




09105600 


T 


009jli 




09105700 


T 


0095*2 




09105800 


T 


0095*3 




09105900 


T 


0098*0 




09106000 


T 


0102*2 




09106100 


T 


0104*2 




09106200 


T 


0107*1 




09106300 


T 


0J07I3 




09106400 


T 


0107*3 


o; 


09106500 


T 


0109*0 




09106600 


T 


0112*2 




09106700 


T 


0114*0 




0910680Q 


T 


0114*1 




09106900 


T 


0115*0 




09107000 


T 


0119*2 




09107100 


T 


0120*3 




09107200 


T 


0123*0 




09107300 


T 


0124*3 




09107400 


T 


0127*0 




09107500 


T 


0127*0 




09107600 


T 


0129*0 




09107700 


T 


0131*2 




09107800 


T 


0133*0 




09107900 


T 


0134*2 




09108000 


T 


0136*0 




09108100 


T 


0140*2 




09108200 


T 


0142*1 




09108300 


T 


0146*3 




09108400 


T 


0146*3 




09108500 


T 


0148*0 




09108600 


T 


0149*1 




09108700 


T 


0150*0 




09108800 


T 


0153*1 




09108900 


T 


0154*0 




09109000 


T 


0158*2 




09109100 


T 


0160*2 




09109200 


T 


0161*1 




09109300 


T 


0165*3 




09109400 


T 


0165*3 




09109500 


T 


0167*0 




09109600 


T 


0168*2 







€ 



begin arow * *cack3 3 j 

pollshurowm, earowcj33, dup* loo* [ arqwc 1 3 j» ** *); 
end; 

polishc10* com3; comment return placeholder array; 
end invert; 



09109700 
09109800 
09109900 
09110000 
09110100 



0170*0 
0171 J 1 

0173*3 
0178*1 
0178*3 



size- 0179 words 



PROCEDURE 


'ORTRANFREEREADj 


: 




________ 


09200000 


T 


0000*0 












START OF REL 


segment; DISK 


AODRESS a 00621 


BEGIN REAL 


PARL 


ss 


-1* 


% 


PARITY "LABEL WORD" 


09200100 


T 


0000*0 




EOEL 


= 


"2* 


% 


END-OF-FILE "LABEL WORD" 


09200200 


T 


0000*0 




LISX 


= 


■>3* 


% 


ACCIDENTAL ENTRY FOR LIST 


09200300 


T 


0000*0 




DKADR 


= 


-IX) 


% 


DISK ADDRESS 


09200400 


T 


0000*0 


name: 


FILX 


= 


-5; 


% 


FILE TANK DESCRIPTOR 


09200500 


T 


0000?0 


REAL 


BLOCK 


- 


5* 


% 


INTRINSIC INTRINSIC DESCRIPTOR 


09200600 


T 


0000*0 




ALGOLREAD 


X 


13* 


% 


NORMAL-STATE I/O INTRINSIC 


09200700 


T 


0000*0 




SELECT 


= 


14* 


% 


FILE STATUS INTRINSIC 


09200800 


T 


0000*0 




JUNK 


= 


17* 


% 


ANOTHER TEMPORARY 


09200900 


T 


0000*0 




ARRAYSTUFF 


X 


18* 


% 


USfD BY LIST FOR ARRAYS 


09201000 


T 


0000*0 




LSTRN 


s 


19* 


% 


INTERNAL LIST POINTER 


09201100 


T 


0000*0 




LISTYPE 


s 


20* 


% 


TELLS TYPE OF LIST ITEM 


09201200 


T 


0000*0 




HOLTOG 


■Br 


21; 


% 


FOR CHARACTER TRANSLATION 


09201300 


T 


0000*0 


ARRAY 


POT 


S 


22C*]* 


% 


POWERS-OF-TEN TABLE 


09201400 


T 


0000*0 


REAL 


FORTERR 


= 


2a; 


% 


FORTRAN ERROR MESSAGE ROUTINE 


09201450 
09201500 


T 
T 


0000*0 
0000*0 


ARRAY 


ARRYC*]* 






% 


GLOBAL TEMPORARY ARRAY 


09201600 


T 


0000*0 




FIBC *3 * 






% 


FILE INFORMATION BLOCK 


09201700 
09201800 


T 
T 


0000*0 
0000*0 


BOOLEAN 


ARRAYTOG* 






% 


LIST ELEMENT WAS ARRAY NAME 


09201900 


T 


0000*0 




COMPLEXTOG 


* 




% 


FIRST HALF OF COMPLEX NUMBER 


09202000 


T 


0000*0 




ORLTOG* 






% 


LIST ELEMENT DOUBLE TYPE 


09202100 


T 


0000*0 




DONE* 






% 


FLAG FOR LIST EXHAUSTED 


09202200 


T 


0000*0 




ESIGN* 






% 


EXPONENT NEGATIVE FLAG 


09202300 


T 


0000*0 




G0TDI6IT* 






% 


TELLS IF CHARACTER SEEN 


09202400 


T 


0000*0 




5EQ* 






% 


TRUE IFF FILE HAS SEQ NUMBERS, 


09202450 


T 


0000*0 




READREC, 






% 


TRUE IFF SCANNER MAY READ A RECORD 


09202460 


T 


0000*0 




SIGN* 






% 


MANTISSA NEGATIVE FLAG 


09202500 


T 


0000*0 




STRINGTQG* 






% 


CONTROLS SCANNER ACTION 


09202600 


T 


0000*0 




twodimtog; 






% 


ON IF ARRAY IS TWQ»DlMENSlONAL 


09202700 
09202800 


T 
T 


0000*0 
0000*0 


INTEGER 


BSIZE* 






% 


NUMBER OF CHARACTERS LEFT IN BUFFER 


09202900 


T 


000010 




BUFF* 






% 


CURRENT BUFFER POSITION 


09203000 


T 


0000*0 




CHAR* 






% 


CONTAINS LAST CHARACTER SCANNED 


09203100 


T 


0000*0 




COUNTER* 






% 


NUMBER CHARACTERS IN STRING 


09203200 


T 


0000*0 




DECADES, 






% 


NUMBER OF DECIMAL PLACES 


09203300 


T 


0000*0 




E* 






% 


CONTAINS EXPONENT 


09203400 


T 


0000*0 




INDEX* 






% 


INDEX INTO ARRAY IF ARRAYTOG 


09203500 


T 


0000*0 




SIZE* 






% 


ARRAY SIZE IF ARRAYTOG 


09203600 


T 


0000*0 




type; 






% 


TYPE OF LAST LIST ELEMENT 


09203700 
09203800 


T 
T 


0000*0 
0000*0 


NAME 


ADDRESS, 






% 


HOLDS ADDRESS TO STORE NEXT DATUM 


09203900 


T 


0000*0 




LISTADR * 


arry; 


% 


HOLDS RESULT OF UISX3 


09204006 


T 


0000*0 














09204100 


T 


0000*0 


REAL 


NUMBER* 






% 


TEMPORARY NUMBER'HOLOER, 


09204200 


T 


0000*0 



* • 



* • 



% D8LPREC NUMBER BUILT BY FREEREAD, 



• 



NUMBERL* NUMBERH 

LABEL uSTSTART* 
LISTEXIT* 
LOOK* 

NUMERICAL* 
PASTPQlNT* 
BYE* 
SCNR* 
AT* 

DECIMAL, 
ERROR* 
STRING* 
STRUNG* 
GETCOMMA* 
LOGICAL* 
EXIT* 



SWITCH SWISH 5a EXIT* NUMERICAL* STRING* NUMERICAL* 

LOGICAL* NUMERICAL* NUMERICAL! 

DEFINE INTEGERv = 1#* 

STRINGV = 2#* 

REALV = 3#* 

LOGICALV = 4#» 

DOUBLEV = 5#* 

COMPLEXV ■ 6#! 

DEFINE KIND = ( F IB [ 4 ] , C 8 *4 3 ) #* 

DATATYPE = ( L I ST YPE • C 44 * 4 ] )#* 

TWOD = (LISTYPE.C38:1])#* 

SIZEF ~ C33 S 153#, 

8ASEF s C18U53** 

IOO = (*FILX)#; 

SUBROUTINE CHECKPRESENCE* 

BEGIN COMMENT GETS NEXT BUFFER FROM ALGOLREAD! 

8SIZE«-CPCMKS*DKADRM'FlLX*ALG0LREAD)'SEO)xa 
BUFF Ss IQD.C335153; 

end checkpresence; 

subroutine readit? 

begin comment order next record read from medium! 

pcmks* dkadr, 0* filx* atgolread)! 

if done then p(xit)* 

IF I0D.C27J13 THEN PCXlT), 
CHECKPRESENCE! 
END READlT! 

REAL SUBROUTINE NEXT! 

BESlN COMMENT GET DESCRIPTOR POINTING INTO AN ARRAY, 

IF TWODIMTOG THEN 

PC*CARRY[lNOEX, [33*7333. INDEX , E 40 * 8 3 * CDC) 

ELSE PCCARRY[INDEX33)! 

NEXT la polish; 
END NEXT ITEM INSIDE AN ARRAY; 



09204205 
09204300 
09204400 
09204500 
09204600 
09204700 
09204800 
09204850 
0920486Q 
09204900 
09205000 
09205100 
09205200 
09205300 
09205400 
09205500 
09205600 
09205700 
09205800 
09205900 
09206000 
09206100 
09206200 
09206300 
09206400 
09206500 
09206600 
09206700 
09206800 
09206900 
09207000 
09207100 
09207200 
09207300 
09207400 
09207500 
0920760Q 
09207700 
09207800 
09207900 
09208000 
09208100 
09208200 
09208300 
09208400 
09208700 
09208800 
09208900 
09209000 
09209100 
09209200 
09209300 
09209400 
09209500 
09209600 
09209700 
09209800 



0000*0 
000050 
0000*0 
0000*0 
OOOO'O 
0000*0 
OOOO'O 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0001*0 
0001*0 
0003*3 
0005*1 
0005*2 
0005*2 
0006*0 
0006*0 
0007*1 
0008*1 
001010 
0011*0 

OOll'l 

0011*1 

0012*0 
0012*0 
0012*1 
0015*0 
0016*0 
0016*1 
0016*2 



n 



AND 



subroutine lisje lement; 

begin comment gets address to store next datum, 

diddles certain toggles as required; 
liststart? 

if arraytog then 
begin address »■ next/' 

if (index !s index + dbltog+u>size then 

arraystuff*arraytq6*cqmpuext06*0 ; 
go to listexit; 

end; 

if complextog then 

begin address * = clistadrc 1 ] ]; complextog ** 

go to listexit; 
end; 

PCO); LISTADR := CLISX3; 
complextog*(type«-datatype)=complexvj DBLTOG^-TYPE'DQUBLEV 

IF ARRAYSTUFF/O THEN 
BEGIN 

ARRAYTOQMJ P( LI STaOR*MEM CLI STADR . 1 1 8 115 33 ) 1 

S1ZE«-(INDEX«-ARRAYSTUFF.8ASEF) + ARRAYSTUFT.SIZEF i 

TWODIMTOG^NOT P(LOD,TOP); P(DEL) f 

GO TO LISTSTART! 



o; 



end; 

ADDRESS 

listexit: 



♦ [LisTADRton; pcdel); 



END GET NEXT LIST ELEMENT; 

SUBROUTINE SCANNER ; 

BEGIN COMMENT GENERAL PURPOSE SCANNER •"» CHARACTER AT A TIME. 

PURLOINED FROM BASICINPUT ROUTINE BY WWF4; 
LOOK? IF BSlZE-0 THEN READIT; 
STREAMCIS S -U BUFF, 

N5=IF BSIZE<63 THEN bSIZE ELSE 63* STRlNGTOG); 
BEGIN SUsBUFF; C I * =C I + STRINGTOG; GO TO DEBLANK; 

comment blanks significant within strings! 
gnci tally!*tally+i; di**lqc i; dssslit m 0"; 

di!*di+6; dsj^chr; go to exit; 
deblank! ncif sc*" " then jump out to gnc; 

tauly:=tally + i; si*=si + n; 
EXIT! ni-tally; buffissi; 
end stream; 

BSIZE »■ BSIZE-P(XCH); % UPDATE 
BUFF ** polish; % UPDATE 

IF CCHAR«-POLISH)<0 THEN 
IF BSIZE=0 THEN 

BEGIN 

IF GOTDIGIT THEN CHAR*"*" 

ELSE IF READREC THEN GO LOOK 

END 

else go look 
scanner; 



CHARACTER COUNT 
BUFFER POINTER 



ELSE eu LUUK ; 

end scanner; 

subroutine logic alcompare ; 

begin comment compares logical to . true . * , tru . * . tr . * . t, » 

. false. ,. fals. ,. fal.». fa, >.f. ; 
stre am (op(xch)*c2*c0unter-l#cl*8-c0unter*e» number) ; 



OR 



09209900 
09210000 

09210100 
09210200 
09210300 
09210400 
09210500 
09210600 
09210700 
09210800 
09210900 
09211000 
09211100 
09211200 
09211300 
09211310 
09211400 
09211500 
09211600 
09211700 
09211800 
09211900 
09212000 
09212100 
09212150 
09212300 
09212400 
09212500 
09212600 
09212700 
09212800 
09212900 
09213000 
09213100 
09213200 
09213300 
09213400 
09213500 
09213600 
09213700 
09213800 
09213900 
09214000 
09214100 

09214200 
09214250 

09214275 
09214300 
09214350 
09214355 
09214360 
09214400 
09214405 
09214410 
09214415 
09214416 
09214425 



T 

T 

T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0016*2 
0017*0 

0017*0 
0017*0 
0017*0 
0017*1 
0019*2 
002l*3 
0024*0 
0024*2 
0024*2 
0024*3 
0027*1 
0027*3 
0027*3 
0028*3 
0032*1 
0033*0 
0033*2 
0036*1 
0039*0 
0040*2 
0041*0 
0041*0 
0042*0 
0042*0 
0042*0 
0042 8 1 
0042*1 
0043*0 
0043*0 
0043*0 
0045*0 
0046*0 
0049*0 
0050*0 
0050*0 
0051*0 
0051*3 
0053*1 
0054*0 
0054*2 
0054*3 
0056*0 
0056*2 
0057*2 
0058*3 
0059*1 
0060*1 
0061*2 
0062*1 

0062*1 
0062*2 

0062*2 
0063*0 
0063*0 
0063*0 



* 



► » 






BEGIN 

si*loc number; si*si+ci; di«-loc 
if c2 scsdc then if sc*"." then 

END i 



c; oudi+e ; 

TALLY*lJ C+TALLY J 



E*P 
END 



of 



logicalcompaRe 



m 
m 



SUBROUTINE 
SCNRS 



# 

# 



# 



SCAN t 

BEGIN SCANNER ; 
IF 0HARs'V w THEN 

begin readreoo ; 

while char*"=" and bsize>0 do scanner; readrec*! ; 
if bsize-o and gotdigit then char*"*" else go scnr ; 
end ; 

END OF scan ; 

subroutine buildnumber ; 

begin comment builds dblprec number number^ numberh ; 
pcnumbeRl*numberh) ; 
while char<10 do 

BEGIN 

C0UNTER*NUM8ER*-0 ; 

DO BEGIN COUNTER*COUNTER + i; NUMBER*NUMBERxlO+CHAR; SCAN END 

UNTIL CHAR>9 OR COUNTERMI ; 

DECADESf-DECADES + COUNTER ; 

IF DBLTOG THEN PC 0* POHCOuNTER 3>DLM,0, NUMBER* DLA ) 

ELSE P<POTtC0UNTER3»x,NUMBER#+) ; 

end ; 

NUMBERL<-PC.NUMBERH,0 ; 
END OF 8UIL0NUM8ER ; 

REAL SUBROUTINE A^FA ; 
BEGIN 

STREAMCCHARSQ<-0) i 
BEGIN 
SI*LOC CHAR; SI*SI+7; IF SC=ALPHA THEN TALLY*!* CHAR*TALLY 

end ; 

ALFA«-P ; 

end of alfa ; 

subroutine freeread; 

begin comment reads and stores next datum* doing appropriate 

conversions, type of scan is dependent on type of 

list item. operates indifferently on a variety of 

numerical formats; 
gotdigit »» stringtog * = false; 
c0unter*-e«-esign«-numberl*num8erh«-num8er«-decades*g ; 
scan; if char*"*" then go to exit; 
if char>9 then 

if alfa then 

BEGIN 

DO SCAN UNTIL NOT ALFA ; 
IF CHARs»c« THEN 
BEGIN 

do begin do scan 
if char/")" then 
end ; 



UNTIL CHAR>9 END 

go error; SCAN i 



UNTIL CHAR/58j 



09214430 
09214435 
09214440 
09214445 
09214450 
09214455 
09214460 
09214465 
09214470 
09214475 
09214480 
09214485 
09214487 
09214490 
09214495 
09214500 
09214505 
09214510 
09214515 
09214520 
09214525 
09214530 
09214540 
09214545 
09214546 
09214547 
09214550 
09214555 
09214560 
09214565 
09214570 
09214575 
09214577 
09214579 
09214581 
09214583 
09214585 
09214587 
09214589 
09214591 
09214600 
09214700 
09214800 
09214900 
09215000 
09215100 
09215200 
09215300 
09215310 
09215315 
09215320 
09215325 
09215330 
09215335 
09215340 
09215345 
09215350 



T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0066»0 
006650 
0067*2 

0069*1 
0069*2 
0070*0 
0070*1 
0070*1 
0071 '0 
0072*0 
0072*3 
0074*0 
0078*1 
0080*3 
0080*3 
008110 
0081*0 
0081*0 
008l«0 
0081*2 
0082*3 
0082*3 
0084J0 
0087*3 
0090*1 
009112 
0094*0 
0095*3 
0096*1 
0097*1 

0097*2 
0097*2 
0098*0 
0098*0 
0099*1 
0Q99J1 
0100*2 
OlOiSO 
0101*1 
0101*2 
0101*2 
0102*0 
0102*0 
0102*0 
0102*0 
0102»0 
010351 
0107*0 
0j,09»i 
0110*0 
0112*0 
0112*2 
0115*3 
0116*2 
0117*0 
0119*3 
0123*0 



n 



n 



IF CHAR="-" THEN 

Dp /n T fcf 

scan; if notcchar="R" or char*"i m )Then go error; 
scan ; 
end ; 
if char/"*" then go error; scan ; 
end ; 
bye: if cdone*-chars«*«) then readit ; 
if char = "»" then go to string' 
if char="x" then go getcomma ; 
gotdigit 5* true; 
60 to swishctype3j 
numerical' * 

if (sign j= char="-") or char=»+" or char="&" then scan; 
if char>9 then go to decimal/ 
buildnu^ber ; 

DECADES«-0 ; 

IF CHAR="." THEN 

BEGIN SCAN; 

pastpoint:: 

buildnumber ; 
end ; 

if char = w e" or charge" or char* w q" -then 
at? : begin scan; 

if cesign != char*"-") or char*"*" or chars»&« then scan; 
if ce *s char)>9 then go to error; scan; 
while char<9 do 

begin e »= ioxe+char; scan; end; 
if esign then e * = ^e; 
end; 

if abs(number«-e-decades3>69 then go error ; 
p(numberl*num8erh) ; 
if numbered then 

if dbltog then p(pot c69 + arsc number )]* potc abs cnumber ) 1* 

if number<0 then p(dld) else p(dlm)) 

else pcp0tca8s(number)3>if nljmber<q then p(/) else pc*)) ; 
if sign then pcchs) ; 

if dbltog then p c t address] # std, c address t 1 h > std ) 
else begin 

pcxch,del'caddress] } ; 

if type»integerv then 

BEGIN 

IF P(0UP)>&77777?7777777 THEN GO ERROR ; 
PCISO) ; 
END 
ELSE PCSTD) ; 

end ; 
go to getcomma; 
decimals? 

IF CHARs"." THEN 

begin scan; 

if chars9 then go to pastpoint else go to error; 
end; 

NUMRERHM i 

IF CHAR="P" OR CHAR*"E" OR CHAR»"D" THEN GO TO AT; 
ERROR** 



09215355 
09215360 
09215365 
09215370 
09215375 
09215380 
09215385 
09215400 
09215405 
09215410 
09215500 
09215600 
09215700 
09215800 
09215900 
09216000 

09216100 
09216200 
09216300 
09216400 
09216500 
09216800 
09216900 
09217000 
09217100 
09217200 
09217300 
09217400 
09217500 
09217600 
09217700 
09217800 
09217900 
09218000 
09218025 
09218050 
09218100 
09218400 
09218500 
09218600 
09218615 
09218620 
09218625 
09218630 
09218635 
09218640 
09218645 
09218650 
09218700 
09218800 
09218900 
09219000 
09219100 
09219200 
09219300 
09219400 
09219500 



T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0123*0 
012313 
0124*1 
0127«0 
0128*0 
0128*0 
0130*0 
0130*0 
0133*0 
0134*1 
0135*2 
013611 
0140*3 
0140*3 
0146*0 
0147*1 

0148*0 
0148*3 
0149*2 
0151*0 
0151*0 
0152*0 
0152*0 
0154*3 
0157*0 
0162?0 
0165*0 
0166*1 
0169*2 
0171*1 
0171*1 
0171*1 
0173*3 
0174*1 
0175*0 
0178*1 
0180*2 
0184*0 
0185*0 
0187*1 
0187*3 
0188*2 
0189*1 
0189*3 
019150 
0191*1 
0l9l»i 

0193*1 
0193*1 
0193*3 
0193*3 
0194*3 
0196*0 
0197*3 
0197*3 
0198*2 
0202*0 






* • 



IF PARL'O THEN 

PfPARL* MKS, 9* BLOCK); 
P(MKS* FIB[6]* FILX, t 33* 153# 2, FQRTERR); 
STRINGS * 

IF CHAR/ THEN GO TO ERROR! 

COUNTER * = 0; STRINGTOG S a D NUMBER !s " *'; 
DO BEGIN SCANNER i 
STRUNG' » 

IF CHAR/""" THEN 

BEGIN COUNTERJ*COUNTER+U 

STREAM ( CHAR* N 8 'COUNTER* TSsENUMBER 3)1 
BEGIN SIJ=L0C n; SIJ-SI-IJ 

DUsDin; di**di+n; dsjschri 
end stream; 

end; 
end until (counters) r char*"""; 
if counter* then 60 to error; 
pcnumber* [address], std); 
if char/""" then 
begin scanner; if chara""" then go getcomma ; 

if lstrn*c-1) then go to error; 

listelement; 

if lstrn=(-d then go error ; 

number := " "/ counter * = 0; go to strung! 
end; 
getcomma* * 

while char/ m ," and char/"*« do scan; if char*"*" then go bye ; 
go to exit; 

LOGICAL: * 

IF char s, »." then 

BEGIN COMMENT SHOULD BE ".TRUE."* ".FALSE."* OR ABBREVIATIONS; 
NUMBER S- COUNTER 5 s E 5* 0} 

DO BEGIN 

SCAN; NUMBER s* CHAR & NUMBER[ 12 * 18 J 303 ; 
END UNTIL (COUNTER * = CQUNTER*1)*6 OR 

CHARs"*" OR CHARs". M ; 
IF NOT (E«-C0UNTER*2 AND NUMBER? M T*"3 THEN 
BEGIN E*4; PC"Tf?UE"); logicalcompare ; 
IF NOT E THEN 
BEGIN 
IF COUNTER/2 OR NUMBER*"F*" THEN 

BEGIN E*3; P("FALSE M ); LOGICALCOMPARE ; 
IF NOT E THEN GO ERROR ; 
END ; 
e*o ; 
end ; 
end ; 

END ELSE IF CE*-CHAR«"T") OR CHARs"F" THEN 
BEGIN SCAN ; 

IF NOT CCHARs"." OR CHARs",") THEN GO ERROR ; 
END 
ELSE IF NOT C(E*CHAR«i> OR CHAR=0) THEN GO ERROR i 
PCE* [ADDRESS]* STD); Go TO getcomma; 
EXIT** 

end freeread; 

COMMENT ***** ***** START OF CODE ***** ***** *****; 



09219600 
09219700 
09219800 
09219900 
09220000 
09220100 
09220200 
09220300 
09220400 
09220500 
09220600 
09220700 
09220800 
09220900 
09221000 
09221100 
09221200 
09221300 
09221400 
09221500 
09221600 
09221700 
09221750 
09121800 
09221900 
09222000 
09222100 
09222200 
09222300 
09222400 
09222500 
09222600 
09222700 
09222800 
09222900 

09223000 
09223100 
09223110 
09223115 
09223120 
09223125 
09223130 
09223135 
09223140 
09223145 
09223200 
09223300 
09223400 
09223405 
09223410 
09223420 
09223425 
09223500 
09223600 
09223700 
09223800 
09223900 



0202»0 
0202*3 
0204*1 
0206*1 
0206*1 
0208*1 
0210*2 
0212*0 
0212*0 
0212*3 
0214*2 
0215*3 
0216*1 
0217*1 
0217*2 
0217*2 
0219*3 
0221*0 
0221*3 
0222*2 
0225*1 
0226*3 
0228*0 
0229*2 
0233*0 
0233*0 
0233*0 
0237*1 
0238*1 
0238*1 
0239*3 
0240*1 
0242*0 
0242*0 
0244*3 
0246*2 
0249*0 
025l»2 
0254*0 
0254*2 
0255*0 
0256*3 
0259*0 
0259*3 
0259*3 
0260*2 
0260*2 
0260*2 
0267*1 
0269*0 
0271*1 
0271*1 
0274*2 
0275*3 
0275*3 
0276*1 
0276*1 



• 

• 



END 



4* FQRTERR); 



FILXENOT 33*-PARi; FILXCNQ? 43«-EOFL>' 
FIB ** FILXENOT 23; 

IF FIBC53, [43123^2 THEN 

POLISHCMKS, o* 2, FIL** i , SELECT); 
CHECKPRE8E-NCEI ARRAYSTUFF :s q} 

IF FIBCOl'O THEN F 1 8 C 3 ?* i; 
IF FIBE03*! AND KlND*2 THEN 

POLlSH(MKS, FIBC63, FILX , t 33 ! 15 3 * 
IF K*[FI8[U31#T0P) THEN P(OEL) 

ELSE BSIZE«--(SEC*-(SEQ«-(*(4 I NX P(XCH ) ) ) f t 36 : 6 3 )XQ ANp 

AND 
+8SIZE ; 
lstrn«-readrec*1 j 

do begin if done*lstrnscm) thfn readit; ulstelement 
if (done * = clstrn«c-1))) then readit; 
freereao; 
end until false! 
fortran free field read; 



SEQ*8 
SEQ^9)x8 



09224000 
09224100 

09224200 
09224300 
09224400 
09224500 
09224600 
09224700 
09224710 
09224720 
09224730 
09224740 
09224800 
09224900 
09225000 
09225050 
09225100 
09225300 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0276*1 
02871-0 

0288*3 
0290*1 
029211 
0293*3 
0296*2 
0299*1 
0301*3 

0303*2 
0306*3 
0309* 1 
0310*3 
0312«0 
0316*0 
0319*0 
0320*0 
0320*3 



c 

i 
i 



SIZE* 0321 WORDS 



• 
• 



AT WORD 
THE LOW 



THE i-ST 
0<ABS(N3<23 



# 



PROCEDURE COBOLDECIMALTOQCTALCONVERTCA) ; %% INTRINSIC # 9151, 

START OF REL 

VALUE A; NAME A ; 

% THIS PROCEDURE CONVERTS A STRING oF N BCD DIGITS* STARTING 

% ADDRESS A* CHARACTER OFFSET $, INTO A DOUBLE-LENGTH VALUE, 

% PART OF THIS IS STORED IN S, THE HIGH PART IN N« IF N . E 1 J 1 3 = 1 * THEN 

% THE SIGN OF THE VALUE IS OBTAINED FROM THE ZONE BITS OF 

* CHARACTER (BCD DIGIT)* OTHERWISE FROM THE LAST. 0<S<7, 

BEGIN 

REAL N*A«2, SsN»l, Q = 9, C * 

REAL H0LD1*H0LD2*H0LD3 ; NAME k\i 

LABEL B,D>E*T8>G ; 

c*=m>o; Al**CH0LDl3; 

STREAM(A*S,JSIGN?*IF Q THEN ELSE 1#NUMD **ABS (N")"l* 

SAVSIJ*0#H0LD*sEH0LDl3 ); 
BEGIN 

sijxa; si * =si+s; savsu=si; 
si:=si+jsign; 
di*=di+jsign; 
ds:=numd num; 

JSIGNCSI J=SAVSi; 

dsjsCHr; 
end; 

ajsai; s:=o; 
pcoib n; 

IF (N*ABSCN))<8 THEN 
BEGIN 

STREAM(C*S*A,N); 
IF NOT Q THEN GO 
END 
ELSE BEGIN P(0) ; 
IF N>16 THEN 
BEGIN 
STREAM(S>Z<-Q#ASN«-N' p 16>CA<-rC3> 



DUaHOLD;); 



BEGIN SI*a; 

d; n*p ; 



SI*SI + SJ DI«-LOC C; DS*N OCT END 



09300000 
SEGMENT; DISK 
09300100 
09300200 
09300300 
09300400 
09300500 
09300600 
09300700 
09300800 
09300850 
09300900 
09301000 
09301005 
09301010 
09301012 
09301015 
09301020 
09301025 
09301030 
09301050 
09301065 
09301070 
09301075 
09301080 
09301100 
09301200 
0930l|00 
09301400 
09301500 
09301600 
09301700 
09301800 
09301900 



T 0000*0 
ADDRESS * 



00632 



T 
T 
T 
T 
T 
T 

T 
T 

C 
T 
P 
C 
C 
C 
C 

c 
c 
c 
c 
c 
c 

C 

c 

T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0003*1 

0006*3 
0007*2 
0007*2 
0008*2 
0009*0 
0009*2 
0010*0 
0011*1 

0011*2 
0011*3 
0013*1 
0013*2 
0015*0 
0015*2 
0019*0 
0020*1 
0020*1 
0021*0 
0021*3 
0022*1 



• » 






BEGIN 

sua; si«-si+s; oi*loc a; ds*n oct; dialog s ; 
os«-8 oct; di«-ca; ds«-s oct j 
end ; 

P(0*Ta>DLH>DU) > 
B* P(0#T8>DLM,0*AB5CC),DtA) j 

END 
ELSE BEGIN 

STREAM(S:A,N«"N»8*CA«.rc]) ; 
BEGIN 

sua; si*si+s; dk-loc s; ds*n oct; duca; ds*8 oct ; 
end ; 

IF P(DUP)>P(6) THEN GO BJ PC T8# x, ABS{ C )r + ) ; 

end ; 

IF C*0 AND Q THEN 
BEGIN 

pcc>oia i j; go e ; 
Teni 100000000.0 ; 
G**: 5496.0 ; 

end ; 

IF Q THEN 5*S+N-1 j 

d* stream(S:a); begin si*a; si*si+s; s«-tally; di*-loc sj oi*di+7* 

ds*zon; eno; 
P(P=?ao*oiA u?) ; 
ei n*pctrb n ; 

end ; 
s*p ; 

end of coboldecimaltooctalconvert ; 



09302000 
09302100 
09302200 
09302300 
09302400 
09302500 
09302600 
09302700 
09302800 
09302900 
09303000 
09303100 
09303200 
09303300 
09303400 
09303500 
09303600 
09303700 
09303800 
09303900 
09304000 
09304100 
09304200 
09304300 
09304400 
09304500 
09304600 
09304700 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 

T 
T 
T 
T 



0024*3 
0024*3 

0026'2 
0027*1 
0027*2 
002812 
0030*1 
0030»l 

0030*3 
0033*0 
003310 
0035*0 
0035*1 
0037*3 
0037*3 
003gso 
0039*2 
0040*2 
0042*0 
0043*0 
0043*0 
0045*2 
0048*1 
0048*3 
0049*2 
0050*1 
0050*1 
0050*3 



SIZE* 0051 WORDS 



ft 



PROCEDURE COBOLOCTQLTODECIMALCONVERTCA,L*H#S»N#R,T); % INTRINSIC # #152. 



VALUE L#H#R*N»S 
% THIS PROC 
% OF N BCD 
% OFFSET S, 
% BY R DIGI 
% TRUNCATIO 
% 1-ST CHR 
% A8S(T).U 
% SCALING); 
% AFTER SCA 
BEGIN 

INTEGER IR« 
REAL Bp17» 
ARRAY TEN=? 
LABEL HLF#T 
IF R<0 THEN 
BEGIN 
STREAM 

■N*N + R.J 

end ; 

IF T,C 
IF H.C2JU 



*T; REAL L>H>R# 
EDURE CONVERTS T 
DIGITS, THE STRI 

PRIOR TO THE CO 
TS# I.E. CL*H) I 
N/J-SIGN TOGGLE: 
OF THE STRING; T 
7»l]«i s> TRUNCA 

ABSCT). £46*13*1 
LING). NOTE THAT 



START OF REL 
NfStJ} NAME A ; 

HE DOUBLE-LENGTH WORD CL#H) INTO A STRING 
NG STARTS AT WORD ADDRESS A# CHARACTER 
NVERSION, CL»H) IS SCALED-TO-THE-LEFT/RHT 
S DIVIDED^MULTED BY 10*R, T IS A COMBINED 

T • C2S 13 = 1 s> PUT THE SIGN OF CL*H) IN 
.Cl*U = l => PUT SIGN IN THE LAST CHR; 
TE (L#H) BEFORE CONVERSION UNO AFTER 

*> ROUND (L*H) BEFORE CONVERSION (AND 

0<S<7, 0*N<23, 



R# IH*H, 
S£RR=19, 

3 c * 3 ; 

8*T16 ; 



CS,N> A); 
R*Q ; 



il=l ; 

WHsU, 



DM0D»2U Q*9 ; 



8EGIN 0I«*DI+Sl NCDS^LIT^O") END ; 



1 S 2 3-0 THEN H «• 
THEN P(Q>H/TENCR 



ABS(H); 

]) ELSE PCL#H#TENCR+27]*TENtR],DLD) 



09400000 
SEGMENT; DISK 
09400100 
09400200 
09400300 
09400400 
09400500 
09400600 
09400700 
09400800 
09400900 
09401000 
09401100 
09401200 
09401300 
09401400 
09401500 

09401600 
09401700 
09401800 
09401900 
09402000 
09402100 
09402200 



T 0000*0 
ADDRESS » 



T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*0 
0000*0 

0000*0 
0000*3 

0001*1 
0004*2 

0006*2 
0006*2 
0009*1 



00634 



€ 






l*o ; 

if p(a8scq«-p)>dup)<p(hlf) then h<-r«-serr«-0 

else begin 

if serr*p(dup)>ten[23] then p( tenc 27 + n] , tenc hi > dmod* b* xch ) i 

IF ■P(DUP}tC-2il3 THEN 

BEGIN IF T THEN P(HLF^); H*£IR*P3 DIV P(T8) END 
ELSE BEGIN 

IF NOT T THEN P (0* HL.F, DL A ) ; H«-P ; 
H*P(L*P»H#0#IL*Pa»H*om6*DUD*HLF#-)#XCH*DEL>0#T16jDLM» 

OLS) ; 
lR*P<R*P#H,0*IH<-PCR>H,0,TO>DLD*HLF#-)>XCH,OEL*0#T8*DtM# 
DLS,HLFf) ; 

end ; 

END I 

IF NS8 THEN 

BEGIN P(L*0 OR HXO OR R>TENtNl OR N*0) ? 

STREAM(R,N,S,A); BEGIN DI*DI + S; SI*LOC Hi DS*N DEC END ; 
END 
ELSE IF N<16 THEN 

BEGIN PCL/O OR H>TENCN-83) ; 
STREAMCH*R#N*N-8#S*A) I 

BEGIN Ol*DI*Si SI*LOC Hi DS*N DEC* DS*8 DEC END I 
END 
ELSE BEGIN P( L2TEN [N*163 ) i 

STREAM(L»H#R#N*N»'16'>S#A) J! 

BEGIN DUDI + S; Sl«-LQC L* DS«-N DEC; D5*8DEC; DS«-8DEC END 
END ; 
IF P OR SERR THEN IF PC 1 * WH , C 18 8 15] ,DUP >*0 THEN P(DIB 0,«O } 
IF Q<0 THEN 
BEGIN 

IF T>0 THEN 
BEGIN 

STREAM(N*N-2,S#A) '* 
BEGIN 

oi*oi+s; ds*set; ds«-reset; di*di+nj ds*-resetids*reset 

END I 

pcxit) ; 

HLF?!8 0.499999999999 ) 

T16HI 10000000000000000,0 ; 

T88J? 100000000,0 ; 
END I 
STR£AM(S*S + N-1»A); BEGIN DI*DI+S; DS*-SET; DS*RESET END i 

end ; 
end of coboloctaltodecimalconvert ; 



09402300 


T 


09402400 


T 


09402500 


T 


09402600 


T 


09402700 


T 


09402800 


T 


09402900 


T 


09403000 


T 


09403100 


T 


09403200 


T 


09403300 


T 


09403400 


T 


09403500 


T 


09403600 


T 


09403700 


T 


09403800 


T 


09403900 


T 


09404000 


T 


09404100 


T 


09404200 


T 


09404300 


T 


09404400 


T 


09404500 


T 


09404600 


T 


09404700 


T 


09404800 


T 


09404900 


T 


09405000 


T 


09405100 


T 


09405200 


T 


09405300 


T 


09405400 


T 


09405500 


T 


09405600 


T 


09405700 


T 


09405800 


T 


09405900 


T 


09406000 


T 


09406100 


T 


09406200 


T 


09406300 


T 


09406400 


T 


09406500 


T 


09406600 


T 



0014 
0015 
0017 
0019 
0023 
0024 
0027 
0028 

0030 
0035 

0035 
0040 
0041 
0041 
0041 
0042 
0046 
0049 
0049 
0051 
0054 
0056 
0058 
0058 
0060 
0062 
0064 
0064 
0068 
0069 
0069 
0070 
0070 
0072 
0072 
0074 
0074 
0075 
0076 
0077 
0078 
0078 
0081 
0081 
SIZE 3 00 



j 2 
«1 

81 
52 
'3 

52 
*3 
II 
52 
?0 
83 
»1 
*2 
52 
''?, 

n 
13 

83 
*3 

SO 
10 
51 
80 
»0 
80 
8 2 

n 

«2 

«1 
80 
*2 

»1 
83 
82 
52 

II 

83 

80 
50 
80 
80 
80 
?t 

n 

82 



• 



WORDS 



PROCEDURE COBOLVARSZ; 



BEGIN 
REAL 



TYPE 



* Mi 



START OF REL 



% 0-21 EXAMINE 

X 0*REPLACING FIRST 

% 1*REP/TALLY ALL* 

% 2*LEADING/UNTIL FIRST 



09500000 

segment; disk 

09500100 
09500200 
09500300 
09500400 
09500500 
09500600 



T 000080 
ADDRESS s 00637 



000080 
000080 
000010 
000080 
000080 
000080 



• 



ARRAY DESC » -2C*3! 
REAL CODE = -2* 



ARRAY 



REAL 



DLENGTH 

LNGTH 

SLENGTH 

RCHR 

DOFSET 

SCHR 

SMCHR 

SOFSET 
OFFSET 

DEST 
SOURCE 



9 *|* 

SB m 4 f 
5 ~H, 

a -5* 
a -5, 

= -6t 



•6* 

•7i 

•7 C * 3 , 






• 



RELATE* 
DIFFER* 
NMQD64* 
SAVOFF* 
NDIV64* 
N* 

nwds; 

ARRAY DC*]; 
DEFINE 

REPLACECHR = 
USTP1T0P6 * 

LABEL VARIEXAM*CMQ 
%********************* 
IF TYPES? THE 
D «• CDESTm 
IF TYP£=3 THE 
IF (DIFFER ♦ 
IF TYPE S 10 TH 
BEGIN* 

SLENGTH * OLE 
NM0D64 * SLEN 

end; 

if differxq a 

BEGIN % 
IF 



X 3! VARIABLE SUE SMEAR 

X 4-9! VARIA8LE SjZE RELATE 

% 4«<* 5*2* '6»>* 7eS*8 a =*9s/ 

X 10* VARIABLE SIZE MOVE 

X 11* NEG ALPHA TEST 

X 121 POSITIVE ALPHA TEST 

% RELATE! UUNKA DESCRIPTOR 

* MOVE»SMEAR« *0 

X EXAMINE»U7li3*t IF REP 

X £46113*1 IF TALLYING 

X t«5«l]»l IF REPLACING OR 

X TALLYING UNTIL FIRST 

X MOVE & RELATE* DEST LENGTH 

X SMEARi LENGTH TO SMEAR 

X EXAMINE! LENGTH 

X SOURCE LENGTH (SMEAR! =0) 

X EXAMINE! CHAR TO REPLACE 

X MOVE*RELATE*SMEAR!DEST OFF 

X EXAMINE! CHAR SOUGHT 

X SMEAR! CHAR TO SMEAR 

X EXAMINE! MKS 

X MOVE&RELATE! SOURCE OFFSET 

X EXAMINE! OFFSET 

X MQVE*RELATE*SMEAR*DEST 

X MOVE>RELATE*EXAMlN£iSOURCE 



oi^di-i; suloc P6'> si«>si-i; ds*i chr** 
p1*nmqd64*p2*n0iv64*p3*cndiv64 div 64)* 
p4«.schr#p5*rchr#p6*-0ffset#; 
*smear;x 

********* START HERE 

N GO TO variexam;x 



***************************** 



% VARIABLE MOVE ONLY 



n go to smear;x 
dlength-slengthxo then 

ENX 

ngth; 

GTH,C42!63;% 



ND TYPE>4 AND TYPES9 THEN * IF THERE IS A DIFFER* 
THEN MOVE SHORTER TO JUNKA&FILL OUT WITH BLANKS 
OIFFER<0 THEN % INTERCHANGE TO MAKE DEST THE 
BEGIN % LONGER* SOURCE THE SHORTER 

D * CDEST]; DEST * [SOURCE]! SOURCE * ED3J 

SAVOFF <- sofset; SOFSET <■ dofset; dofSet*o; 
nwds*dlengtH;dlength«-slength;slength*nwds; 



09500700 
09500800 
09500900 
09501000 
09501100 
09501200 
09501300 
09501400 
09501500 
09501600 
09501700 
09501800 
09501900 
09502000 
09502100 
09502200 
09502300 
09502400 
09502500 
09502600 
09502700 
09502800 
09502900 
09503000 
09503100 
09503200 
09503300 
09503400 
09503500 
09503600 
09503700 
09503800 
09503900 
09504000 
09504100 
09504200 
09504300 
09504400 
09504500 
09504600 
09504700 
09504800 
09504900 
09505000 
09505100 

09505200 
09505300 
09505400 
09505500 
09505600 
09505700 
09505800 
09505900 
09506000 
09506100 
09506200 
09506300 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 



0000*0 
0000»0 
0000 10 
0000 10 
0000!0 
0000!0 
0000«0 
0000*0 
0000*0 
0000*0 
0000*0 
000010 
0000!0 
0000*0 
000010 
0000*0 

ooooio 
ooooio 

0000*0 
0000*0 
0000*0 
0000*0 

ooooio 
ooooio 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

ooooio 

0000*0 
0003*1 
0004*1 
0005*2 
0007*1 
0008*2 
0009*0 
0009*3 
0011*0 

ooiuo 

0013*3 
0014*1 
0015*0 
0015*2 
0018*2 
0020*1 







* 



DIFFER * ABS(DIFFER);* 
END ELSE* 
BEGIN* 

IF TYPE<8 THEN TYPE*TYPE-TYPE . C47 * 13* 
+CTYPE. 147*13=0);* 

SAVOFF * DoFSETU 

DOFSET * 0;* 

end;* 
relate * type; 

TYPE «• 10/ 

d * tDEsccon;x 
end;% 
cmd: % transfer or compare fields 

if type^io or differs or relate>0 then nm0d64«-slength , c 42 s 63 ; 
ndiv64 * slength oiv 64;* 
if type<8 then* 

BEGIN* 

STREAM(P0«-0*Pl<-NM0D64j.P2 + NDIV64*P2A<-NDIV64XQ*P3*CNDIV64 OIV 64) 
,P4«-S0URCE,P5«-S0FSET,P6*D0FSET,P7«-TYPE>6,* 
P8*TYpE,[ft7:i]^P9«.D);* 
BEGIN 

si * p«; si * si+ps; di *■ D1+P6; 

ci * ci+p7j go to greq; go to gqlsq;* 

GREG" 

P3(fi3(P0*SUP9*'0i;iF 63SC*DC THEN ELSE* 

BEGIN SI*P0;Dl«-P9;iF 63 SC>DC THEN;* 

JUMP OUT 2 TO XYTi;* 

end?;* 
2(p0*5i;p9«-dihf 63sc»dc then else* 

BEGIN SI«-P0;Dl*P9;iF 63 SC>DC THEN;* 

JUMP OUT 2 TO XYTi;* 
END);* 
IF Sc»DC THEN ELSE* 
BEGIN SI«-SIMJDI«-0W;IF 
JUMP OUT 1 XYTi;* 
END); GO TO LU* 
XYTI* GO TO XYT2U 
G0LSQ5G0 TO L5E8;$ 
LI * P2 (P0«.Si;p9*Di;lF 63SC = DC 
BEGIN SI«"PO;0UP9;iF 63 

JUMP OUT 1 TO XYT2;* 
END);* 
P2A (P0*Sl;P9*Di;lF P2 SC*DC THEN ELSE* 

begin si*po;di*p9;if P2 sc>dc then;* 

jump out i to xyT2;* 
end);* 
if pi sc>dc then;* 
xyt2* go to xyt3;* 

LSEQS 

P3C63(P0<-Si;P9«-Di;iF 63SCsDC THEN ELSE* 

begin si*po;di*p9;if 63 sc<oc then;* 
Jump out 2 to xyts;* 

END)U 

2<P0«-Si;P9«-Di;lF 63SCsDC THEN ELSE* 

BEGIN SI*PO;OI«-P9; IF 63 SC<DC THEN;* 
JUMP OUT 2 TO XYT3;* 

END);* 



sc>dc then;* 



then else* 
sodc then; 



09506350 
09506400 
09506500 
09506600 
09506700 
09506800 
09506900 
09507000 
09507100 
09507200 
09507300 
09507400 
09507500 
09507600 
09507700 
09507800 
09507900 
09508000 
09508100 
09508200 
09508300 
09508400 
09508500 
09508600 
09508700 
09508800 
09508900 
09509000 
09509100 
09509200 
09509300 
09509400 
09509500 
09509600 
09509700 
09509800 
09509900 
09510000 
09510100 
09510200 
09510300 
09510400 
09510500 
09510600 
09510700 
09510800 
09510900 
09511000 
09511100 
09511200 
09511300 
09511400 
09511500 
09511600 
09511700 
09511800 
09511900 



T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 

T 
T 
T 



0023*0 
0024*0 
0024*0 

0024*2 
0026*0 
0029*0 
0029*3 
0030*2 
0030*2 
0031*1 
0032*0 
0033*0 
0033*0 
0033*0 
0037*2 
0038*3 
0039*2 
0040*0 

0042*2 
0044*2 
0046*0 
0046*0 
0047*1 
0048* 1 
0048*1 
0050*1 
0051*1 
0052*0 
0052*1 
0053*3 
0054*3 
0055*2 
0055*3 
0056*2 
0057*2 
0058*0 
0058*2 
0058*3 
0059*0 
0060*3 
0061*3 
0062*1 

0062*2 
0064*2 
0065*3 
0066*1 
0066*2 
0067*1 
0067*2 
0067*2 
0069*2 
0070*2 
0071* 1 
0071*2 
0073*0 
0074*0 
0074*3 



c 

# 



• 



I * 



IF Sc 
BE6I 



XYT3 

L2* 



s GO 
P2 



P2A 






END 

TO X 

(PO 

BEG 

END 
CfrQ 
BEG 



XYTS 

STOR 
END 

END ELSE% 

BEGIN* 

STRE 



END 

IF PI SC 

P8CIF TO 

IF TOGGl 

:PO*TALLY 

stream;* 



*DC T 
N SI* 

JUM 
3; GQ 
YUX 
*Si;p 
IN SI 

JUM 
)*% 

*si;p 

IN SI 
JUM 

>iX 

<DC T 
GGLE 
E THE 
}% 



HEN ELSE* 

si-i;di*di-i;if sc<dc then;* 
p out 1 to xyt3jx 
TO 12;% 



9*Di;iF 63SODC 

♦ P05DUP9HF 63 

p out 1 to xyt;x 

9«-Di;lF P2 SC'DC 
*P0iDl*P9;iF P2 

p Out i to xvti* 



THEN ELSE* 
SC<OC THENU 



THEN ELSEX 

sc<oc then;* 



HE N ; X 

THEN TALLY-i; JUMP OUT 1 TO STOR);X 

N ELSE TALLY«-l;X 



AM(PO* 
,P4* 
P8* 
BEGIN% 

SI «■ 
CI * 
EQUL*X 



0*P1«-NMQD 
SOURCE, P5 
TYPE.C47J 

P4; SI «• 
CI+P7/ GO 



64*P2*NDIV64»P2 
«-S0FSET»P6*D0FS 
1]*P9*D>JX 



SI+P5; DI 

TO equu 



♦• DI + 
GQ TO 



P3( 63CIF 63 s 
PC IF 63 SODC 
IF 1 Sc=OC 
GOTANt GO TO TANLU 
L* P2(IF 63 SCsQC 
P2ACIF P2 SC=D 
IF Pi SC*DC 



TRFRI* 



XYT1 

Tanl 



P3(63 
P2CDS 

J GO T 

*X 
F S f t 3 



• 



XYT2 

DONE 

Li * 



GO TO 
S GO T 
U GO 
P2 



XYT* 

STOR 



P8CIF 

IF TO 

8 pO*T 



(DS*63 CH 
«■ 63 CHR 
XYT2;% 

c c 3 e 1 F it 

JUMP OUT 

(63CIF SC 

JUMP OUT 

IF SC 

JUMP OUT 

Li; 

o xyt; 
to done; 

(63CIF SC 
JUMP OUT 
P2CIF SC 

Jump out 

P1CIF SC 

Jump out 

TOGGLE T 

ggle then 
ally;% 



C*DC THEN ELSE 
THEN ELSE JUMP 
THEN ELSE JUM 

THEN ELSE JUMP 

C THEN ELSE JUM 

then; GO TO X 

R); 2(DS<-63 CHR 

); os «• P2 chr; 



A«-NDIV64/0,P3*CNDIV64 DIV 64) 
ET>P7<-<TYPE?.10) + <TYPE>10)>% 



P6; 
trfr; go to gotan;% 

jump out 2 to xyt13u 

OUT 2 TO XYTl);% 

p out 1 to xytd; go to l;x 

OUT 1 TO XYTDJX 
P OUT 1 TO XYT1);% 

yti;x 

)/ DS*CHR);« MOVE 64x64 
OS «- PI chr; GO TO OONE1JX 



»*LF>* UE1. IF 
3 TO VYT2 Fl?F 

=alpha then if 
3 to xyt2 else 
=alpha then if 

1 TO XYT2 ELSE 



U< 



TO 



JUMP OUT 3 
SCS M Z" THEN 

JUMP OUT 3 
SC< W Z M THEN 

JUMP OUT 1 TO XYT2);* 



M + l {LSE.Jp 
11. XYT2));!T 
SI*SI+l ELSE% 
TO XYT2));* 
SI*SI+1 ELSE* 



*ALPHA THEN IF 

2 TO XYT ELSE 
"ALPHA THEN IF 

1 TO XYT ELSE 
sALPHA THEN IF 

1 TO XYT ELSE. 
HEN ELSE TALLY*- 

TALLY*i;x 



scs"z" then si*si+1 elsex 
jump out 2 to xyt)>;x 
scs"z w then si*si+1 elsex 
jump out 1 to xyt);x 
scs"z" then si*si+1 elsex 
jump out 1 to xyt);x 
1; jump out 1 to stor>;x 



09512000 
09512100 

09512200 
09512300 
09512400 
09512500 
09512600 
09512700 
09512800 
Q9512900 
09513000 
09513100 
09513200 
09513300 
09513400 
09513500 
09513600 
09513700 
09513800 
09513900 
09S14000 
09514100 
09514200 
09514300 
09514400 
09514500 
09514600 
09514700 
09514800 
09514900 
09515000 
09515100 
09515200 
09515300 
09515400 
09515500 
09515600 
09515700 
09515800 
CftSl59Ct 
09516000 
09516100 
09516200 
09516300 
09516400 
09516500 
09516600 
09516700 
09516800 
09516900 
09517000 
09517100 
09517200 
09517300 
09517400 
09517500 
09517600 



007550 
0075*3 

0076*3 
0077*1 
0077:3 
0078*0 
0079*3 
0080*3 
0081*1 
0081*2 
0083*2 
0084*3 
0085*1 
0085*2 
0086*1 
0088*0 
0088*3 
0089*0 
0089* 1 
0089*1 
0089*3 
0092*1 
0095*1 
0096*3 
0096*3 
0098*0 
0099*1 
0099*1 
0101*3 
0103*3 
0105*2 
0105*3 
0107*3 
0110*0 
0111*0 
0111*0 
0113*2 
0115*3 
0116*0 

cju«c 

0118*2 
0121*1 
0123*1 
0126*0 
0127*2 
0129*0 
0129*1 
0129*2 
0129*3 
0132*0 
0134*1 
0136*1 
0137*3 
0139*3 
0141*1 
0143*1 
0143*3 



e 



€ 



• 



DQNE:% 

end streams 
end;% 

if type/io then pcrtn);% 

if differ>0 then 
begin % fill out dest with blanks to make up diff 

pcslen6th+d0fset^dup»8,ldv#*p(.0}»inx#,d»*»7»lnn».d0fset»*); 
smearmndiv6* «■ (nwds<-( c c differ* c dlength-slength >-* 

(N*-ca"D0FSET),[ft5»3])) DIV 8) - (DIFFER^))) DIV 64U 
STREAM CP t *0 I FFER.U5 133* P2*00FSET*P3«'8xCDIFFER48)+N*P4*NHDS# 
P4A*NWDS*0*P5*-NDlV64#P5A<-N0IV64;f0>P6*SMCHR*P7<.<TYPE*3 
AND SMCHR*" M )*P8*.D);% 
BEGIN 

DI «• DI+P2; P8+DIJ P7(SI«.L0C ?7 ', S I*S 1-1 ) ; % 

ci*ci+P7; go to blnk; GO to smr;% 

BLNKIP3(DS * LIT " "); GO TO CQNTJ% 

SMR: P3CDS «■ i chr; si*Si-d;% 

cont8si *• p9; p5cds <■ 63 wds); p5a(ds «■ p5 wds};* 

paa(ds 4. p4 wds);» 

ci«-ci+P7; go to finb; go to fins;* 
finbjpkds «• lit « «)l go to xytix 

FIN3:P1(DS * 1 CHR; SI*Si*1)JX 
XYT*% 



end stream; 



end;* 



if relate>o then 

BEGIN 

sofset 

SOURCE 
SLENGTH 



% blank fill done 

% go back and do compare 



«• savoff;* 

*■ CDESTm 

* olength;* 



type «■ relate;* 

DQFSET *• 0;% 
D «- COESC3JX 

GO to cmd;i 
end;* 

p(xit); 
variexamj 1% 

nm0d64 * lnqth.c42i61jx 
n0iv64 ♦ lngth div 64;% 
if type'o then 

Q ft A ■ t| 

STREAM(LISTP1T0P6*P7«-S0URCE);!8 
BEGIN 

di*di+P6; si«-loc P5; si*si-i; 

P3(63(63(IF SC*DC THEN JUMP OUT 

2C63CIF SC«DC THEN JUMP OUT 

IF SC'DC THEN JUMP OUT 

P2(63(lF SCsDC THEN JUMP OUT 2 

P2CIF SC=DC 

PKlF SC = DC 

go to xyt; 
replacechr; 



THEN 
THEN 



JUMP 
JUMP 



OUT 

OUT 



* REPLACING FIRST 



3 to rep; si«-si-i)>;% 

3 to rep; SI*SI-1J)JX 

i to rep; si*si-i; y,% 

to rep; si+si-m;% 

to rep; si«-si-n;* 

to rep; si«-si-n;* 



REP! 
XYT * 
END 

END ELSE 

BEGIN 



stream; 

IF TYPE' 



1 THEN 



* REP AND/OR TALLYING ALL 



STREAM(P0«-0«LlSTPlT0P6,P7«-3«C0DE)"OsREP&TALLYM = TALLY only 



09517700 


T 


0144S0 


09517800 


T 


0144*0 


09517900 


T 


014451 


09518000 


T 


0144*1 


09518100 


T 


014553 


09518200 


T 


014652 


09518300 


T 


014750 


09518500 


T 


0150«3 


09518600 


T 


015153 


09518700 


T 


015751 


09518800 


T 


0160«2 


09518850 


T 


016253 


09518900 


T 


016550 


09519000 


T 


016510 


09519100 


T 


016750 


09519200 


T 


016850 


09519300 


T 


016952 


09519400 


T 


0170 J 3 


09519450 


T 


017351 


09519500 


T 


017452 


09519600 


T 


017552 


09519700 


T 


017750 


09519800 


T 


017851 


09519900 


T 


017851 


09520000 


T 


017852 


09520100 


T 


017852 


09520200 


T 


017951 


09520300 


T 


017953 


09520400 


T 


018052 


09520500 


T 


018152 


09520600 


T 


018251 


09520650 


T 


018350 


09520660 


T 


018353 


09520700 


T 


018453 


09520800 


T 


018551 


09520900 


T 


018551 


09521000 


T 


018552 


09521100 


T 


018650 


09521200 


T 


018751 


09521300 


T 


018852 


09521400 


T 


018951 


09521500 


T 


018953 


09521600 


T 


019253 


09521700 


T 


019253 


09521800 


T 


0193*3 


09521900 


T 


0197*0 


09522000 


T 


0199*3 


09522100 


T 


020151 


09522200 


T 


020450 


09522300 


T 


020650 


09522400 


T 


020850 


09522500 


T 


0208*1 


09522600 


T 


0209*1 


09522700 


T 


020951 


09522800 


T 


020952 


09522900 


T 


0210*3 


09523000 


T 


021151 



# 



• 



t * 



BEGIN 



2sREP 0NLY ,, (P8«-SCuRCE)U 



DI*0I + P61 SK-LOC P5; SI*Sl-l** 
P3(63(63(IF 1 ScsDC THEN* 

begin ci«-ci + p7; go to tall1i go to tallin 
tallij si*poi si*si+8; po*si; si*loc ps** 
ci*ci+P7; GO to repi; GO to nxti;* 
replacechr; si<-loc ps;* 



P3C 



REPJI 

end;* 

nxti* si*si-i; )n;* 

2C63CIF 1 SC*DC THEN* 
BEGIN CI*CI+P7; GO TO TALL2; GO TO TALL2I 
TALL2J Sl*POi SI*Sl + 8; PO«-Si; Sl*LOC P5;* 
CI*CI+P7^ GO tO REP2; GO TO NXT21X 

replacechr; si«-loc ps;* 



P3( 



REP2* 

end;* 

NXT25 
IF 

BEGIN 
TALL3! 



Sl*Sl-lJ )));* 
1 SC=DC THEN* 

ci«-ei + P7; go to TALL3; go to tall3; 
si*po; si*si+8/ po*sii si«-loc ps;x 
ci<-ci + p7; go to rep3i go to nxt3jj* 
replacechr; Sl*LOC P5;* 



REP3I 

end;* 

NXT3? si*si-in;% 

P2C63CIF 1 SCsOC THEN* 

BEGIN CI*CI+P7; GO To TALL4; GO TO TALL4J 

tall4* si*po; si#-si+ei po«-si; si«-loc ps;* 

CI*CI+P7; GO TO REP4; GO TO NXT4JX 

REpfli replacechr; si«-loc ps;* 

end;* 

nxt48 si*si-i; ));* 

P2CIF 1 SC*DC THEN* 
BEGIN CI«-CI+P7; GO TO TALL5; GO TO TALL$; 
TALL5! Sl*PO; SI«-Sl+8; POt-Si; Sl*LOC P5U 

ci<-ci+p7; go to rep5; go to nxt5;* 
replacechr; si*loc ps;* 



END 
END ELSE 
BEGIN 



REPS* 

end;* 

NXT5? 

PlCIF 
BEGIN 
TALL6: 

REP6S 

end;* 

NXT6! 

stream; 



si*si-i; >;* 

1 Sc*DC THEN* 

ci*ci+p7; go to tall6; go to tall*; 
si*po; si*-si+8; po*si; si+loc ps;x 
ci«-cl + p7; go to rep6; go to nxt6;* 

REPLACECHR; Si*LOC P5;* 

si*si-i; );* 



GO TO REPi; 



GO TO REP2; 



GO TO REP3; 



GO TO REP4; 



GO TO reps; 



GO TO REP6; 



1ST/LEADING 



• 



*REP/TALLY UNTIL 
STREAM(P0*0*LlSTPlT0P6#P7«-3-C0DE.[46»23,P8*C0DE.[45;i]#X 

P9*S0URCE);* 
BEGIN 

di«-di+P6; si<-loc ps; si*si-i;* 

P3(63(63(CI*CI+P8; GO TO REPLl* GO TO REPUF1U 

REPLi: IF lSC^DC THEN JUMP OUT 3 TO XYTUGO TO DOlTi; 
REPUFi: IF 1SC=DC THEN JUMP OUT 3 TO XYTi;% 
DOlTi: CI-CI + P7; GO TO TALLi; GO TO TALLIED TO REPli 
TALL1' SK-PO; SI*SI + B* PO*Sll Sl*LOC P5i% 



09523100 
09523200 

09523300 

09523400 

09523500 

09523600 

09523700 

09523800 

09523900 

09524000 

09524J00 

09524200 

09524300 

09524400 

09524500 

09524600 

09524700 

09524800 

09524900 

09525000 

09525100 

09525200 

09525300 

09525400 

09525500 

09525600 

09525700 

09525800 

09525900 

09526000 

09526100 

09526200 

09S26300 

09526400 

09526500 

09526600 
09526700 
09526800 
09526900 
09527000 
09527100 
09527200 
09527300 
09527400 

09527500 
09527600 
09527700 
09527800 
09527900 
09528000 
09528100 
09528200 
09528300 
09528400 
09528500 
09528600 
09528700 



T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0214 ; i 

0215*2 
0215*2 
021652 
0218*0 
0219*1 
0220*1 
022ltj 
0222*2 
0222*2 
0223*2 
0225*0 
0226*1 
0227*1 
0228*1 
0229*2 
0229*2 
0230*2 
0231*2 
0232*3 
0233*3 
0234*3 
0236*0 
0236*0 

0236*2 
0237*3 
0239*0 
0240*0 
0241*0 

0242*1 
0242*1 

0243*0 
0244*0 
0245*1 
0246*1 
0247* 1 
0248*2 
0248*2 
0249*0 
0250*0 
0251*1 
025211 
0253*1 
0254*2 
0254*2 
0255*0 
0255*1 
0255*1 
0255*3 
0260*2 
0261*1 
0261*1 
0262*1 

0264*1 
0266*0 
0267*2 
0268*3 



• 
* 
• 




# 
• 



c 



• 



L4; 



m 
m 



ci«-ci+p7; go to rep1j go 
reph replacechr; st«-loc ps;« 

NXTli SI*SI"1 )5>J GO TO 12} 
L2S P3C 2C63(C1«-CI+P8I GO TO REPL2; GO TO 
REPL2S IF ISC^DC THEN JUMP OUT 3 
REPUF2UF ISC-DC THEN JUMP OUT 3 
0QIT2I CI*CI+P7; GO jO TALL2; GO 

TALL2: si*po; si^si+a; po*su si 

CI*CI+P7i GO TO REP2; GO 
REP2* replacechr; Si«-LOC P5;% 
NXT2J SI«-SI-1 )))> GO TO L3; 
L3* P3( CI«-CI + P8; GO TO REPL.3/ GO TO 
REPL3: IF ISC'DC THEN JUMP OUT 1 
REPUF3UF 1SC = DC THEN JUMP OUT 1 
DOIT3I CI*CI+P7; GO TO TALL3; GO 
TALL3: Sl*PO; SI«-SI+8* PO*Si; SI 

CI<-CI + P7J GO TO REP3; GO 
REP35 REPLACECHR; Sl*LOC P5t% 
NXT3* SI*SI-1 ); GO TO L4; 
P2C63CCUCI+P8; GO TO REPL4; GO TO 
NEPL4: IF JSC^DC THEN JUMP OUT 2 
REPUF4HF 1SC*DC THEN JUMP OUT 2 
D0IT4* CI*CI+P7; GO TO TALL4; GO 
TA|_L4: SI4.RO* si<-si+8; PO*Si; SI 

ci*ci+P7; go to rep^; 60 
rep4* replacechr; si«-loc ps;s 
nxt4* si*si"i n; go to ls; 

P2CCUCI + P8; GO TO REPL5; GO TO 
REPL55 IF 1SC*DC THEN JUMP OUT 1 
REPUF5UF 1SC«0C THEN JUMP OUT 1 
D0IT5: CI4-CI+P7; GO TO TALL5; GO 

TALL5* si*po; 3i<-si + e; po*si; SI 

ci4-d+P7; go to reps; go 

REP5S REPLACECHR; Sl«-LOC P5i% 
NXT5: SI*SI*l ); GO TO L6; 

PHCI*CI+P8J GO TO REPL6; GO TO 
REPL6! IF 1SC*0C THEN JUMP OUT 1 
REPUF6UF 1SCSQC THEN JUMP OUT 1 
D0IT6? CI4-CI + P7; GO TO TALL6; GO 
TA1.L6: SI«-P0; SI«-Sl + 8; PO*Sll SI 

CI*CI+P7; GO TO REP6; GO 
REP6S REPLACECHR; Sl*LOC P5i% 
NXT6* SI*SI-1 );% 



L5: 



L6? 



TO NXTliX 

XYTi? GO TO XYT2; 
REPUF2;% 

TO XYT2/G0 TO D0IT2; 
TO XYT2;% 
TO TALL2;gO TO REP2; 

4-loc ps;% 

TQ NXT2'X 

XYT2* GO TO XYT3; 

REPUF3;% 

TO xyt3;go to doits; 

to xyt3;% 

to tall3;go to reps; 

♦LOC P5i% 

to nxts;* 

xyt3* go to xyt4; 

REPUF4U 

TO xyt4;go to doit*; 

TO XYT4;% 

to talla;go to REP4; 

<-LOC P5)% 
TO NXT4;% 

xyt4* go to xyts; 

repufs;% 

to xyts;go to doits; 

to xyts;% 

to talls;go to reps; 
<-Loc ps;% 
to nxts;x 

XYTS! GO to xyt; 
REPUF6;* 
to xyt; GO TO D0IT6; 

to xyt;* 

to tall6;g0 to rep6; 

«-LOC P5'f% 
TO NXT6;* 



XYT 

END 



STREAMS 



end;% 

END C 



IF CODE. [46*1] 

obolvarsz;% 



THEN P(RTN);% 



09528800 
09528900 
09529000 
09529100 
09529200 
09529300 
09529400 
09529500 
09529600 
09529700 
09529800 
09529900 
09530000 
09530100 
09530200 
09530300 
Q9530400 
09530500 
09530600 
09530700 
09530800 
09530900 
09531000 
09531100 
09531200 
09531300 
09531400 
09531500 
09531600 
09531700 
09531800 
09531900 
09532000 
09532100 
09532200 
09532300 
09532400 
09532500 
09532600 
09532700 
09532800 
09532900 
09533000 
09533100 
09533200 
09533300 
09533400 
09533500 



T 
T 
T 

T 
T 
T 
T 
T 

T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SIZ 



0269*3 
0270*3 
0272*0 
0273*2 

0275*2 
0277*1 
0278*3 
0280*0 
0281*0 
0282*0 
0283*1 
0284*3 
0286*1 
0287*2 
0288*2 
0289*3 
0290*3 
0291*3 
0293*0 
0294*0 
0295*3 
0297*1 
0298*2 
0299*3 
0300*3 
0301*3 
0303*0 
0304* 1 
0305*3 
0307*0 
0308*0 
0309*1 
0310*1 
0311*1 
0312*2 
0313*2 
0315*0 
0316*1 
0317*1 
0318*2 
0319*2 
0320*2 
0321*3 
0322J1 

0322*1 
0322*2 
0322*2 
0324*0 
E* 0325 






WORDS 



PROCEDURE COBOLIONONDSK; 

BEGIN 
REAL CODE 



% PRONOUNCED COBOL-10-NON-DISK 



START OF REL 



« -i; % 0«READ»1=WRITE*6»WRTBLK 



09600000 

SEGMENT; DISK 

09600100 

09600200 



T 0000*0 
ADDRESS ■ 
T 0000*0 
T 0000*0 



00648 



* > 



• 



• 
• 



INTEGER 



%LOCALS 



DEFINE 



NAME 
REAL 


DLOC 
NUMWOS 




KEY 




CHNNL 




LINES 




SKIPS* 



LINAGE 



REAL 
ARRAY 

REAL 



NAME 
ARRAY 
NAME 
ARRAY 

REAL 



IOMASK 
FIB C* 
FILECT 
PERFOR 
C080LI 

floc; 

FP8 
MEM 
PGUSE 

T,RT, 

TCW, 

TCOIF, 

UNITYP 

ENDREE 

DESTC* 



Rl a 

MGEN = 
QDSKs 



L / 

3j 



ARRAY 

AF 

ARR 

ARROW 



BCOUNT 
BINARY 

BF 
8REAK 

BREAKOUT 

BRR 
BUFFNUM 

buffsize 

BUFFSZ 
BUFTOP 

CHECK(CHECKl) 
ONERR(ONERRl) 

CLOSEANOOPEN 

COUNT 

DELAY 

DISK 

DONE 

ENDFILE 

ENDPROCESS 

EOF 

FNAM 

FOREVER 



-2* 


% 


•3* 


% 


-4, 


% 


-4, 


% 


-5* 


% 


-6; 


% 



-?} 



POINTS TO BUFFER 10 DESCRIPTOR 

# WDS TO BE WRITTEN 

CARRIAGE RETURN 
LP CHANNEL SKIP 

# LINES TO BE SPACED 
l=5pACE BEFORE PRINT 



% LINE PRINTERS tl*13*l IF LINAGE 

% CLAUSE PRESENT, [33*153* LINAGE LIMIT 

% ON NEXT END-OF-PAGE 



12* 
13, 
15; 

3C*3J 
2; 



% 
% 

% 
% 

% 
% 
% 
% 

% 
% 



FIB ARRAY 

USED TO CALL COBOLFCR 

USED FOR PERFORMING USE ROUTINES 

POINTER TO FIB 
FILE PARAMETER BLOCK 
DUMMY DATA DESC 
PROGRAM USE ROUTINES 

TEMPORARY 

TECH C* NUMBER WORDS TO BE READ 

TECH C8 (ACTUAL RECORD - MlN REC ) 

STORE UNIT TYPE FOR MANY TESTS 

USED ONLY ON READ 

DESTINATION IN MOVEREC 



! C12: 
: C 36* 

' P(0, 

' FI8C 

: FI8C 

; till 

■■ FI8C 

' IF(R 
PC 

' [24* 

'■ FIBt 

: FIBt 

; FIBC 

! FIBt 

■■ IF P 

: ON 

;P<MKS 

MKS 

: FIBt 

: TIP, 

= (UNI 

: TIP, 

' FIBt 

! FIBt 

: ((*DL 
: FIBt 
<(NOT 



123#, 
123#, 
NQT,C 
% 
63#, 
133. t 
13#, 
93 / 
COUNT 
0,0, 1 
123#, 
133. t 
183. t 

183 C8 

163#, 
CDUP) 
ERRl, 
% 
,1*0, 
,FLOC 
123 * 
C20«l 
TYPE* 
C19J1 
53»t4 
53. C3 
OC). t 
43. CI 
05. [9 



% FILE USE ROUTINE 
% REEL USE ROUTINE 
BUFFSlZE-WOROSLEFT),TIP,INX,STD>## 
THIS INSERTS THE GROUP MARK 
% BLOCK COUNT 
24*1]#, % 1bBINARY,Q*ALPHA 

% FILE USE ROUTINE 
, % BREAKOUT RESTART POINT 



# 

MOD 
2, COM 

1*9] 
3 5 15 3 
88810 
* COP 
X(CHE 
17, CO 

THE 
FLOC, 
,1,FI 

3 #, 

(FIBt 

3 #, 

0813 

9«23# 

27:1] 

3811] 

8393 



FIBt93>*0 THEN 
#DEL,OEL)#,% CALL BREAKOUT 

% REEL USE ROUTINE 
#, % * OF BUFFS REQUSTED 
#, % BUFFER SIZE (REQUESTED) 
Ut % SIZE FOR CONCATINATES 
Y OF TOP IOD* POINTS TO BEG BUFF 
CK1) THEN P(CHECK1,0,FL0C,#, 
M,DEL*DEL,DEL,DEL>* P(DEL>** 
ABOVE ARE USED QN BLOCK+REC CHKS 
4,FILECTRL, %CLOSE NO RWD 
LECTRL)#, % OPEN INPUT 

% USED FOR BLOCKING TECH»A,B 
% THIS ALLOWS ONE CYCLE DELY 
43 ,C8843))»4#, 

X 1= 10 COMPLETED 
#, % ALREADY PASSED EOF 
, % SEE OPTIONAL AND ENDFILE 
)#, % FIRST EOF OR EOT 
#, % FILE NAME INDEX IN FPB 
#, * UNTIL END TIME 



09600300 
09600400 

09600500 
09600600 
09600700 
09600800 
09600900 
09601000 
09601100 
09601200 
09601300 
09601400 
09601500 
09601600 
09601700 
09601800 
09601900 
09602000 
09602100 

09602200 
09602300 
09602400 
09602500 
09602600 
09602700 
09602800 
09602900 
09603000 
09603100 
09603200 
09603300 
09603400 
09603500 
09603600 
09603700 
09603800 
09603900 
09604000 
09604100 
09604200 
09604300 
09604400 
09604500 
09604600 
09604700 
09604800 
09604900 
09605000 
09605100 
09605200 
09605300 
09605400 
09605500 
09605600 
09605700 
09605800 
09605900 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
0000*0 

0000*0 
000080 
0000*0 
000080 
000080 
0000*0 
0000 8 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
000080 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 
0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
000080 
OOOQJO 
0000*0 

0000*0 

0000*0 

0000*0 

0000*0 
0000*0 

ooooio 

0000*0 
0000 8 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 

0000*0 
0000*0 

0000*0 

0000*0 
0000*0 

0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



howopen 


= FlBC5JtC41*33#» % lsQPEN INPUT*0= OPEN OUTPT 


09606000 T 


0000«0 




% 1 > CLOSED 


09606100 T 


0000*0 


INFILE 


■ FIBCi3J.C27il]#, % FILE OPEN INPUT 


09606200 T 


ooooso 


INVALIDUSER 


= FIBC53<0#> % INVALID USER NOT PARITY 


09606300 T 


0000*0 


INXlINAGE 


* P CLOCQFC TR#DUP*LOD# LINES* ADD* XCH#«0#j» 


09606400 T 


0000*0 


IOERR(IOERRl) 


* PC0*FL0C*I0ERRl*l7*CQM,DEL*DEL*DEL)#* 


09606500 T 


0000*0 




% ABOVE CALLS IOERROR ROUTINE 


09606600 T 


0000*0 


LABELED 


■ NOT FIB[43,E2H3** 


09606700 T 


0000*0 


LABEQ 


* FIBC53. [17*13 ** % LABEL EQUATED FROM DISK 


09606800 T 


0000*0 


LBLPTR 


3 FLOCC1J #* % LABEL POINTER 


09606900 T 


0000*0 


LINAGELIM 


= FIBC13## % LOGICAL LENGTH OF PRINTED PAGE 


09607000 T 


0000*0 


LINEPRINT 


= FI8C203 #* % CF*1 IS PRINTFILE 


09607100 T 


0000*0 


LINTOG 


s LINAGE. Cl:i]#, % TRUE IF LINAGE PRESENT 


09607300 T 


0000*0 


LOCOFCTR 


s FIB[33## % PRT LOC OF LINAGE COUNTER 


09607400 T 


0000*0 


MABUSE 


■ FIBU3.[1*13#, % MAY BE USE RTNS PRESENT 


09607500 T 


0000*0 


MAXR 


= FIBC 183 C8S 381 l03#,X MAX REC SZ FOR CONCATS 


09607600 T 


0000*0 


MAXREC 


= FI8tl83.C33U53## * MAX REC SZ 


09607700 T 


0000*0 


MINREC 


* FIB[183,[FF] #» % MINIMUM RECORD SIZE 


09607800 T 


0000 *0 


NONSTD 


» FIB C 53 «, C 16 : ilf, % NON-STANDARD LABELS 


09607900 T 


0000*0 


NUMBUF 


» FIBC133.C10S 9]#, % NUMBER OF BUFFERS ASSIGNED 


09608000 T 


0000*0 


NUMREC 


s FIBC113 #* % RECORDS PER BLOCK 


09608100 T 


0000*0 


NXTLINAGE 


* LINAGE»C33:i5]#* % PRINTER* LINAGE LIMIT 


09608200 T 


0000*0 


NXTREEL 


= PCMKS*2,1,FL0C'4* X THIS DOES REEL SWITCHING 


09608300 T 


0000*0 




FILECTRL)## % 


09608400 T 


0000*0 


OPTIONAL 


• FIBt 53.C39S1]#, % OPTIONAL FILE NOT PRESENT 


09608500 T 


0000*0 


PARITY 


* TIP.C28il3## % PARITY BIT ON OESC 


09608600 T 


0000*0 


PBIT 


* [2*l3#> X PRESENCE BIT 


09608700 T 


0000*0 


PRESENT 


s CC*DLOC).[2:i3)#* X CHECKS PRESENTSBIT 


09608800 T 


0000*0 


PROPER 


s P(C0DE»P(DUP)# + >P(DUP)s:12, + »REVERSE* + »ai, + ) §, 


09608900 T 


0000*0 




% GENERATES PROPER IOERROR 


09608910 T 


0000*0 


PUNCH 


* UNITYPE*6#* % UNIT IS CARD PUNCH 


09609000 T 


0000*0 


RCOUNT 


s FIBt73 #* X RECORD COUNT 


09609100 T 


0000*0 


RCPRT 


* CFIB[203,[FF3)#* %PRT OF DESC POINTING TO REC 


09609200 T 


0000*0 


READER 


■CUNITYPE MOD ll»0)##% OsREADER 1 1=PSUDQREADER 


09609300 T 


0000*0 


READLBL 


sPCDLOC INX 0*11*11 % THIS READS THE LABEL. 


09609400 T 


0000*0 




*COM*DEL*DEL)#* X 


09609500 T 


0000*0 


RECPERBLK 


= HC03, [30*123 #* % RECORDS PER BLOCK 


09609600 T 


0000*0 


$ SET OMIT m TIMESHARING 


09609690 T 


0000*0 


REMOTEUNIT 


s 10#* % OATACOM IS TYPE 14 ON TSS 


09610100 T 


0000*0 


REMQTEREAD 


S BEGIN P(BUFFSIZE*TIP*1*(-13)*C0M); 


09610200 P 


0000*0 




PCTIP); moverec; 


09610220 T 


0000*0 




P([DLOC[q3 3* l«*l»SUB»RTN); 


09610240 P 


0000*0 




END** 


09610260 T 


0000*0 


REMOTEWRIT 


-BEGIN PCTIP); MOVEREC! 


09610300 T 


0000*0 




PCCDLOCt033#STN); X RESTORE TIP 


09610320 T 


0000*0 




PCNUMWDSxfl,uiNES&KEYCCTF3#0#C"in#C0M* 


09610340 T 


oooo»o 




DEL'RTNJj 


09610360 T 


0000*0 




END#* 


09610380 T 


0000*0 


$ POP OMIT OMIT 




09610390 T 


0000*0 


REVERSE 


* FIBC53.[44;i3 #* % 1=REVERSE 


09610400 T 


0000*0 


SETPRESENCEBIT 


=PCTIP OR MEM *DLOC*«-)#*X SET PRESENCE BIT 


09610500 T 


0000*0 


i SET OMIT ~ NOTCTIMESHARING) 


09610600 T 


0000*0 


SLEEP 


* 36 #* 


09610700 T 


0000*0 


X POP OMIT 




09610701 T 


0000*0 


* SET OMIT = TIMESHARING 


09610800 T 


0000*0 


TAPEE 


* TIP, C 7 * 1 3 #* % 1= TAPES 0»ALL ELSE 


09611000 T 


0000*0 


TECHA 


*CFIBC53.[46»23*1) *>% TECHNIQUE-A 


09611100 T 


0000*0 



€ 

i 

i 
« 
i 
i 
* 



• ■» 



• 



LABEL LP 
SU8RCUTI 

BEGI 
SUBROUTI 

BEGI 



TECHC 

TERMCTER 

TIP 

TOSZF 

UNBLKD 

WAITIO 

WRITEPAR 
WOROSLEF 
RETURN*S 
NE GOUSE 
N P(MKS* 
NE INPUT 
NX 



Ml) 



ITY 

T 

TART»IM 

[FIB3»T 

parity; 



X 

PR 
X 

*0 



CFIBC5J. [46:23*3) #,% TECHNIQUE-C 

P(1#Fl0C*TERM1>17*C0M)#,STERMINATE I/O ERROR 

(*DL0C) #* % LOAD I/O DESC 

C8 J 38S 101#* 

CFI8C53 . C46 J2 3^0 )#* X 1 RECORD PER BLOCK 

PCDLOCMOMASK, % THIS SLEEPS ON I/O 
SLEEP#CQM,DEL>DEL)#*« WAITING FOR A COMPLETE 

FIBt5].t3?l]#, % INDICATES FORCED REELSWITCH 

FI8C173#; X WORDS LEFT IN BUFFER 

OPER*ROVER*EOFSETCKJ 

CALLS USE ROUTINES 
»PERFORMGEN); END/* 



IF 
IF 
IF 



END 
SUBROUTi 
BEGI 



• 



END 
SUBROUTi 



CT * 
(T «- 

NOT 
10 

setpres 
inputpar 

NE OUTPU 
NX 
IF NOT 

BE 

IF 

EN 

SETPRES 

NXTREEL 

OUTPUTER 

NE INPU 

BE 



RT * PGUSEU]«BRR)*0 THEN GOUSE* X INPUT ERROR USE RTN 

FIBC153.BF) t THEN GOOSE* 
PRESENT THEN IF NOT (T OR RT) THEN 
ERR<19 + 10 x REVERSE)* 
ENCEBITI 
ITY*% 

terror;* 



EOF 
GIN 
I 
(T 
T 

d;x 

ENCE 

; % 
ror; 

TEOF 

GIN 
E 
S 
I 
I 



THEN X TAPE WRITE PARITY OR BLANK TAPE 

% OUTPUT ERROR USE ROUTINES 
F (T <• PGUSEC53,BRR)XO THEN GOUSE;* 
* FIBC153.BF) t THEN GOUSE; 
ERM(20);X 



BITU 
REEL 



SWITCH 



eor; 

X EO 

NDFILE «• 

ETPRESEN 

F READER 

F LABELE 

BEGI 

READ 

S 



IF P 
CHEC 
CHEC 
ENOR 
IF M 
IF N 



F OR 
TRUE 

CEBIT 
OR R 

D THE 
N% 

lbl;x 

TREAM 
BEGI 
DI*L 
DI«-D 
DS*C 
DI*D 

end; 

-1 TH 
K(RCO 
KCBCO 
EEL * 
ABUSE 
OT WR 
BEGI 



EQR 
',% 

}% 
EVERSE 

NX 



THEN PC1*RTN);X 



(sent«-0*bc*0,rc«-0»wp*0*l«-5 inx lblptr); 
n x this retreives end of reel 
oc sent; x sentlnel#block & rec count 

1+7; si*l; si*si-i;* 
hr; ds*5 oct; ds<-7 oct;x 
1+7; ds+ chr; 

X 

EN WRITEPARITY * TRUE* 

UNT) 0NERRC16); 

UNT) 0NERRC17); 

Pi X STORE SENTINEL 

THENX 
ITEPARITY THEN 
N X END INPUT REEL USE RTNS 

IF (T«.PGUSECU.BRR)*0 THEN GOUSE** 

IF CT«-PGUSEC13.ARR)*0 THEN GOUSEU 

IF NOT ENDREEL THENX 

BEGIN X END INPUT FILE USE RTNS 



09611200 
09611300 

09611400 
09611500 
09611600 
09611700 
09611800 
09611810 
09611900 
09612000 
09612100 
09612200 
09612300 
09612400 
09612600 
09612700 
09612800 
09612850 
09612900 
09613000 
09613100 
09613200 
09613300 
09613400 
09613500 
09613600 
09613700 
09613800 
09613900 
09614000 
09614100 
09614200 
09614300 
09614400 
09614500 
09614600 
09614700 
09614800 
09614900 
09615000 
09615100 
09615200 
09615300 
09615400 
09615410 
09615500 
09615510 
09615600 

09615700 
09615800 
09615900 
09615950 
09616000 
09616100 
09616200 
09616300 
09616400 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



OQOO'O 
0000*0 

0000*0 
0000*0 
000050 
0000 5 
0000*0 
000080 
0000*0 
0000*0 
0000*0 
0001*0 
0002*3 
0003*0 
0003S0 
0007*0 
0011*0 
0013*3 
00lfl*0 
0019*2 
0019*3 
0020*0 
0020*0 
0021*1 
0021*3 
0025*0 
0029*0 
0030*1 
0030*1 
0031*3 
0033*1 
0033*2 
0034*0 
0034*0 
0036*2 
0038*0 
0041*2 
0042*3 
0043*1 
0045*1 
0048*1 
0048*2 
0048*3 
0049*2 
0050*1 
005013 
0051*0 
0054*2 
0059*0 
0063*2 
0064*0 
0065*0 
0066*3 
0067*1 
0071 * 
0075*0 
0075*2 



t 



* 



€ 



IF 
IF 
IF 



m 
# 



IF 

IF 



END 
SUBRQUTIN 
BEGIN 



INPUTEOF 
E MQVERE 
% 

IF NOT 
P(*RCPRT 
IF NOT P 
IF 



NX 
P( 
WR 
IF 
60 

eor; 
c; 



END 
LABEL 

NONST 
BEG 
END 
CLO 
PCI 
END 

treel; 

DELUDE 

ITEPAR 

TECHC 

TO ST 



END 
LABE 
ED AN 
D THE 
IN% 
FILE 
SEANO 
*RTN) 

;% 

% 

d; 

ITY * 

THEN 
ARTJX 



use; 
led;* 

D NOT 
NX 



if ct*pgusec1j.bf)*0 then 
if (t*pguseujfaf)*0 then 
end;% 

ct*fibc23,brr)x0 then gouse; 

ct*fibc23.arr5/0 then gqusei 

not endreel then* 
begin % end file use 
if ct*fib[23.bf)*q then 

IF (T«-FIB[2:i,AF)*0 THEN 

end;% 
* 



gouse; 
gouse; 



% 
% 



END 
REEL 



routines* 

gouse;* 
gouse;* 



ENDREEL THEN P(1#RTN)U 



* false;* 

open;* 

;* 



% delete branch returns 
false; 
p(,tcw,lod*tnumwds,sto); 



* MOVES RECORD BETWEEN WORK AREA AND BUFFER 



% MAY BE ERROR OR EOF 



End m 
subroutin 

BEGIN 



ONE THEN WAITI0;% 
#TIP INX o); 
RESENT THEN 
CODE THEN 

IF EOF THEN BEGIN OUTPUTERROR; PCDEL'TIP INX 0); END 

ELSE P<XCH#PCDUP).C88 10:U.NUMWDS,ISD) 
ELSE IF EOF THEN INPuTEOFEOR; 
DEST * IF CODE THEN P ELSE PCXCH);* 
STREAMCFROM^-PtNUMWDS^E^PCDUPJ.t 36:63 *X*DEST);% 
BEGIN* 

si*fromiecos*32 wds;ds*32 wds); os«-numwos wds;* 

ENDU 
P C DEL 5 ; X 

WOROSLEFT ■> *PCDUP) - numwds; 

DL0CC03 * C IF REVERSE THEN NOT (NUMWDS-1 ) ELSE NUMWDS) INX TIP! 
RCOUNT <• *PCDUP) * II 
IF CODE THEN % CHECK FOR 

if not present then outputerror % output parity error 
else else 

if not present then inputparity; * input parity 
if break then breakout; 
overecordtoandfromworkarea; 

e prel; * DOES ACTUAL I/O 



END P 

SUBROUTIN 

BEGIN 



pctip»dloc,prl*ded; 
bcount * *pcoup) + ii 

rel;% 

e skipper; 

while lines > do 



% DO 10 

% UP BLOCK COUNT 

% DOES SPACING ON PRINTER 



09616500 
09616600 
09616700 
09616800 
09616900 
09617000 
09617100 
09617200 

09617300 
09617400 
09617500 
09617600 
09617700 
09617800 
09617900 
09618000 
09618100 
09618200 
09618300 
09618600 
09618700 
09618710 
09618750 
09618800 
09618900 
09619000 
09619100 
09619200 
09619300 
09619400 
09619500 
09619600 
09619700 
09619800 
09619900 
09620000 
09620100 
09620200 
09620300 
09620400 
09620500 
09620600 
09620700 
09620800 
09620900 
09621000 
09621100 
09621200 
09621300 
09621700 
09621800 
09621900 
09622100 
09622300 
09622400 
09622500 
09622600 



T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0076*0 
008050 
008450 
008450 
0088*0 
0092*0 

0092*2 
0093*6 
0097*0 
0101*0 
010150 
0l0i*0 
0101*0 
0104*0 
0105*0 
0105*2 
0108*0 
0110*2 
0111 JO 
0111*0 
0112*2 
0113*0 
0115*2 
0118*2 
0119*0 
0119*1 
0120*0 
0120*0 
0123*1 
0125*3 
0127*0 
0127*3 
0132*1 
0134*1 
0137*0 
0139*0 
0141*1 
0141*1 
0143*1 
0143*2 
0143*3 
0145*3 

0150*1 
0152*1 
0152*2 
0155*2 
0156*2 
0160*0 
0165*1 
0165*2 
0166*0 
0166*0 
0167*2 
0169*2 
0169*3 
0170*0 
0170*0 






• 



BEGIN 

IF NOT DONE THEN WAITIO; 

IF NOT PRESENT THEN OUTPUTERRQR/ 

OLOCCQJ «• TIP & 1C18U7I1] & 16[27I42I6]J 

IF LINES * 1 THEN 

& 2C27;46S23; 



• 



END S 

SUBROUTIN 

BEGIN 

IF NUMW 
IF MAX 



dlocco] «• tip 
prel; 

LINES 

end; 
kippingallthqselines; 

E SOLPJ 



♦ LINES - 2; 



% makes thy prynteR go 



IF LINTQG 
DS > 17 T 
REG > \7 
RT «- BUFF 
IF NOT UN 
8EGI 
IF T 



then inxlinage; 
hen numwos «- 17; 
then maxrec «■ 17; 

» wordsleft; 

then 



SIZE 
8LKD 
N 
ECHC 



% *0 MEANS DATA PRESENT 



THEN 
BEGIN 

IF NUMWOS > MAXREC 
IF NUMWOS S THEN 

end; 

if numwds > wordsleft then skipbfr 
else begin mqverec; go lpret 



then numwds * maxrec; 
teRM(36); 



♦■ TRUE 

uri^; end; 



end; 

IF CHNNL 
IF 3KIPBF 
BEGI 






ENO 
BEGI 



f T 

! THE 

i 

IF N 
IF N 
DLOC 



IF L 
PREL 
WORD 
IF C 
IF U 
BUFT 
MOVE 

ELSE 

N 
IF R 



HEN 
N 



LINES + O; 



OT DONE THEN WAITIO; 

OT PRESENT THEN OUTPUTERR 

CO] 4r FLAGC8UFTQP & CRT » 
&RT TOSZF 
&(LINeS>0)C27? 

INES ■ 1 THEN DL0CCO3«-TIP 

> 

sleft * buffsize; 

lines * lines - 2) > th 

nitype=12 then if not don 

op,ccf3 <• tip; 

rec; 



or; 

O) U8U7UJ 

46123 & CHNNUC29«4«I4]); 
& 2C27U6J23; 



en skipper; 
e then waitio; 



0C27I42I6] 
iZF); 



MOVE 
DLOC 



IF L 



T X THEN 
BEGIN 

DLOCCO] * FLAGCBUFTOP & 

g RT TOS 

prel; 

wordsleft «■ buffsize; 

if unitype*i2 then if not done then waitio; 

buftop.ccf] «• tip; 

end; 
rec; 
co] * flagcbuftop & cline 

& (BUFF 

& CHNNL 

INES ■ 1 THEN DL0CC03«-TIP 



S>0H27!46*23 
SIZE*WORDSLEFT) TOSZF 
C29f 44143 )* 

& 2C27«46«23; 



09622700 
09622800 
09622900 
09623000 
09623100 
09623200 
09623300 
09623400 
09623500 
09623600 
09624600 
09624700 
09624800 
09624810 
09624820 
09624900 
09625000 
09625100 
09625200 
09625300 
09625400 
09625500 
09625600 
09625700 
09625800 
09625900 
09626000 
09626100 
09626200 
09626300 
09626400 
09626500 
09626550 
09626600 
09626700 
09626800 
09626850 
09626900 
09627000 
09627100 
09627200 
09627300 
09627400 
09627500 
09627600 
09627700 
09627750 
09627800 
09627850 
09627900 

09628000 
09628100 
09628200 
09628300 
09628350 
09628400 
09628500 



T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
C 
C 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0171 
0171 
0174 
0177 
0180 
0180 
0183 
0184 

0185 

0185 

0186 
0186 
0186 
0189 
0191 

0195 
0197 
0199 
0199 
0201 
0201 
0205 
0207 
0207 
0209 
0211 
0211 
0213 
0213 
0214 
0217 
0220 
0221 
0222 
0225 

0229 

0231 

0233 

0236 

0240 

0242 

0244 

0244 

024 

02 

024 

024 

024 

025 

025 

025 

025 

02 

02 

02 



02 



245 




2 
6 
8 
258 
260 



)26 



1*1 

353 

66»1 











• 



• 
• 

• 



• 



# 



PRELJ 

WORDSLEFT * BUFFSIZE; 

II (LINES ♦ LINES - 2) > THEN SKIPPER! 

IF UNITYPE=12 THEN If NOT DONE THEN WAITIQ; 

8UFT0P,tCFj * TIP! 



END. 



LPRETURN? 



IF LINTOG THEN IF ( *P(LOCOFCTR ) ) ^UlNAGELlM THEN 
BEGIN 

P(0*LOCQFCTR*STO)J 
LINAGELIM <■ NXTLINAGE* 
P(1*RTN); 

end; 

PCO^RTN)! 
END GOINTOPRINTER; 
SUBROUTINE WRIT! % WRITES A BLOCK 

BEGIN 

DL0CCO3 ♦ FLAGCBUFTQP & (BUFFS iZE-WQRDSLEFT ) TOSZF); 

IF TAPEE THEN IF NOT BINARY THEN ARROW ELSE 

else if punch then dlocco] «• tip & chnnlc 32 *47* u i 
prel; 
wordsleft * buffsize; 

BUFTOP.tCF] «• TIP; 

end writ;* 
subroutine reed; % reads a block 

BEGIN* 

DLOCCO] 






«- FLAG(FIBC163);% 

tip;* 



prel;* 

BUFTOP.CCF3 * 
WORDSLEFT ♦ 0; 

end reed;* 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% start here %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
fib «■ *(flgc *• (not 2) inx dlooix 
if fpbcfnam+33, [42*63*43 then % dummy 

if code*0 then go eofsetck else p(0,rtn); 
if disk then go to p( cobol iodsk > '> % 
IQMASK *• §2000000000;* 

STARTUP NOT(ENOPROCESSsO OR CODE) THEN GO TO EOFSETCK; 

IF CODE > 1 THEN % SHOULD BE WRITE BLOCK 

BEGIN 

IF CODE i 6 THEN TERMC25); * UNRECOGNIZED CODE 
IF HOWOPEN * THEN GO IMPROPER; * 10 ERROR 
IF WORDSLEFT < BUFFSiZe THEN 

IF LINEPRINT THEN GOLP ELSE WRIT; 
PCO#RTN); 

END writeblock; 

(1-CQDE)*H0W0PEN THEN % CHECK USE VS HOW OPEN 
IF H0W0PEN>1 THEN TERM( 31 + CODE ) % CLOSED 
ELSE TERM(PROPER);* * USAGE 

UNITYPE=10 OR UNITYPE«13 THEN 

BEGIN 

Remotewrit; 



IMPROPER: IF 



IF 



IF 



if code then 
remoteread; 

eno; 
code then 

if lineprint then 

BEGIN 



GOLP 



* WRITE 
ELSE 



A RECORD 



09628600 


T 


0269<2 


09628650 


T 


0271 JO 


09628700 


T 


0273*0 


09628800 


T 


0276*0 


09628900 


T 


0280*2 


09629100 


T 


0282*3 


09629200 


T 


0282*3 


09629300 


T 


0282*3 


09629400 


T 


0285*2 


09629500 


T 


0286*0 


0962^600 


T 


0287?0 


09629700 


T 


0288*3 


09629800 


T 


0289*1 


09629900 


T 


0289*1 


09630000 


T 


0289*3 


09630900 


T 


0290*0 


09631000 


T 


0290*0 


09631100 


T 


0290*0 


09631200 


T 


0293*3 


09631300 


T 


0300*1 


09631400 


T 


0304*2 


09631500 


T 


0306*0 


09631600 


T 


0308*0 


09631700 


T 


0310*1 


09631800 


T 


0310*2 


09631900 


T 


0311*0 


09632100 


T 


0311*0 


09632200 


T 


0312*1 


09632300 


T 


0313*0 


09632500 


T 


0315*1 


09632700 


T 


0316*2 


09632800 


T 


0316*3 


09632900 


T 


0316*3 


09632910 


C 


0321*3 


09632920 


C 


0324*2 


09633000 


T 


0326*3 


09633100 


T 


0329*3 


09633200 


T 


0330*2 


09633300 


T 


0333*0 


09633400 


T 


0333*3 


09633500 


T 


0334*1 


09633600 


T 


0336*3 


09633700 


T 


0338*3 


09633800 


T 


0340*2 


09633900 


T 


0346*6 


09634000 


T 


0346*2 


09634200 


T 


0346*2 


09634300 


T 


0348*2 


09634400 


T 


0352*3 


09634500 


T 


0357*3 


09634600 


T 


0359*2 


09634700 


T 


0360*0 


09634800 


T 


0365*2 


09634900 


T 


0371*1 


09635000 


T 


0371*1 


09635100 


T 


0371*2 


09635200 


T 


0374*0 



€ 
i 



• 
* 



• 






IF TECHC THEN 
BEGIN 

if numwds > maxrec then numwds «■ maxrec; 

if numwds > wordsleft then writ; 

if numwds < minrec then termc36j; 

end; 

MOVEREC; 

IF WORDSLEFT < MINREC THEN WRIT; 

PCO'RTN); 

end; 

% read a record 
rover: if wordsleft < then 

f3egin x a new block was read 

if not done then waitio; 
wordsleft * 

memcuf reverse then i else not o) inx tipi; 
if reverse then dlocto] * not c maxrec*2 } inx tip* 
end; 
if techc then 

BEGIN 

NUMWDS <■ P(. NUMWDS, LOD*,TCW,STD*MINREO; 

MOVEREC; 

IF (TCW«-TCW) > MAXREC THEN TCW * MAXREC; 

IF TCW < NUMWDS THEN 

IF CTCW*0) AND C W0RDSLEFT+NUMWDS»1 ) THEN 
BEGIN 

reed; 

RCOUNT * *PCDUP) - It 

GO rover; 

END ELSE TERMC26 + CTCW^O)); 
IF (TCDIF 4. TCW - NUMWDS) > THEN 
BEGIN 

STREAMCTCDIF#E*PCDUPKE36?6]# 
FROM* TIP INX 0* 
DEST * NUMWDS INX <*RCPRT)>; 
BEGIN SI * FROM; 

E(D5«-32 WDS; DS<-32 WDS); 
DS * TCDIF WDS; 

end stream; 
dlocco] «■ tcdif inx tip; 

WORDSLEFT «- *P(DUP) - TCDlFf 

numwds ♦• tcw; 
end; 

P(RCPRT,0UP,L0D, NUMWDS, DIa 38*DIB 8*TR8 io#xch>std); 

END * TECH C FILE READING 

ELSE MOVEREC; 
IF WORDSLEFT < OR UNBLKD THEN REED; 
P(0»RTN)J 

eofsetck: 

if enqfile then term(15); 

endfile «■ true; 

pu»Rtnj; 
end cobolionondisk; 



09635300 
09635400 
09635500 

09635600 
09635700 
09635800 
09635900 
09636000 
09636100 
09636200 
09636300 
09636400 
09636500 
09636600 
09636800 
09636900 
09637000 
09637100 
09637200 
09637300 
09637400 
09637500 
09637600 
09637700 
09637800 
09637900 
09638000 
09638100 
09638200 
09638300 
09638400 
09638500 
09638600 
09638700 
09638800 
09638900 
09639000 
09639100 
09639200 
09639300 
09639400 
09639450 
09639500 
09639550 
09639600 
09639700 
09639800 
09639900 
09640000 
09640100 
09640200 
09640300 
09640500 



T 
T 
T 

T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
SIZ 



0374 
0376 
0376 
0380 
0383 
0386 
0386 
0388 
0392 
0392 
0392 
0392 
0393 
0394 
0397 
0397 
0402 
0407 
0407 
0408 
0409 
0411 
0413 
0417 
0417 
0420 
0421 
0422 
0424 
0424 
0427 
0429 
0429 
0430 
0*31 
0434 
0434 
0435 
0436 
0436 
0437 
0439 
0440 
0440 
0443 
0443 
0445 
0449 
0449 
0449 
0452 

0454 

0455 

E= 045 



WORDS 



procedure coboliodsk; 



START OF REL 



^LOCALS 



BEGIN 
REAL RCW 
REAL 
NAME 
REAL 



CODE 
DLOC 
NUMWOS 

BS > 



+ 0) 

-i; 
-2; 
-3; 



$ SET 
DEFINE 



INTEGER 
REAL 
REAL 
ARRAY 

NAME 

ARRAY 

ARRAY 

REAL 
NAME 

NAME 
ARRAY 

INTEGER 
REAL T; 
INTEGER DAS! 
OMIT * NOT SHAREDISK 



C080LIQNQNDSK= 14; 
DEST ; 
FIB [*]; 
floc; 

FPB = 3[*3I 

HC*3> 

INTINT = 5) 

MEM = 2; 

PERFORMER = 13; 
PGUSE»24C*JJ 

rt ; 



3USED TO CALL COBOLIONONDSK 

% 0*READ»l*WRITE*2*SEEK,6sWRTBLK> 

% POINTS TO BUFFER I/O DESC 

% 9 WdS TO BE WRITTEN 

% USED IN COMPUTING DISK ADOR 

% DESTINATION IN RANDOM MOVE 

% FIB ARRAY 

% POINTER TO FI8 

% FILE PARAMETER BLOCK 

% DISK FILE HEADER 

% INTRINSIC INTRINSIC 

* DUMMY DATA DESC 

% USED FOR PERFORMING USE ROUTINES 

% PROGRAM USE ROUTINES 

% USED IN COMPUTING DISK ADDR 

% TEMPORARY 

% USED TO COMPUTE DISK ADDRESS 



AF 

ARR 

BCOUNT 

BF 

BOUNDED 

BREAK 

BREAKOUT 

BRR 

BUFFNUM 
BUFFSIZE 
BUFFSZ 

BUFTSP 
COUNT 

DINXPRT 

DONE 

DISK 

ERBIT 

FLAGINWA 

FNAM 

ENDFILE 

ENDPROCESS 

EOF 

GETSEG 

KEY 

HAVEWA 

HOWQPEN 

INVALIDUSFR 

INWA 

INXPRT 



« C 12 : 

: [368 
! FIBC 

= cm 

: FIBC 

; FIBC 

: IFCR 
PC 

' C24? 

; FIBC 

! FIBC 

! FIBC 

■ FIB 

! FIBC 

■• PC*R 

1 TIP, 

; (UT 

: FIBC 

: OCli 

! FIBC 

■■ FIBC 

■ FIBC 
C(*DL 

; p(Fp 

T 

; FIBC 

(INWA 

■IN WO 

FIBC 

: FIBC 
FIBC 

; PCNU 



123#, 

93 « C2I 1 

93 i 
COUNT M 
0»Q*12> 
12 3 # * 
133. til 
183, C3» 
183 C8 *8 
C16J#, 
123 t, 
CPRT & 
C19J13 
s4)#* 
133, C19 

nn#* 

43.C13? 
53.C40S 

53* C39: 

0O.C27 

BCCBSJ- 

*HM»ll 
1 5 J # t 1 c 
OR FIB 
RK AREA 
53, [411 

53<0#> 
203>0#, 
MWOS IN 



% 

% 

% 

% 

1#, % 

ft » % 

OD FI8C9 

COM'DEL* 

% 

93 *> % 

15]#f % 

8 1 3 #* X 

% 

% 

CCTC 

% 

% 

% 

% 

% 

% 

% 

% 



TIP 



»n *» 



113*1 

13 ## 
23#* 
s 1 3 3#^ 

FNAM)*33 

*COM*DEL 

UOJ#* X 

C203 ,CCF 

OR HAVE 

33## % 

% 

% 

% 

X *RCPRT 



FILE USE ROUTINE 

REEL USE ROUTINE 

BLOCK COUNT 

FILE USE ROUTINE 

TRUE IF BOUNEO FROM ABOVE 

BREAKOUT RESTART POINT 

3)sO THEN 

DEL>#>* CALL BREAKOUT 
REEL USE ROUTINE 
# OF BUFFS REQUSTEO 
BUFFER SIZE (REQUESTED) 
SIZE FOR CONCATINATES 
USED ON 1-0 AND RANDOM 
USED FOR BLOCKING TECH*A#8 

3*RCPRT#*)##XUPDATE POINTER 
I* 10 COMPLETED 
DISK IS UNIT TYPE OF 4 
IOERR 19 NOT YET SPOUTED 
SAYS WE ARE IN WORK AREA 
FILE NAME INDEX IN FPB 
ALREADY PASSED EOF 
SEE OPTIONAL AND ENDFILE 
FIRST EOF OR EOT 

.FpBCB53>FpBCBS + n, 

>DEL>DEL»OEL*DEL*DEL)** 
REL PRT LOC OF ACTUAL KEY 

3>|)#*% TRUE IF WE ARE NOW 
MADE IT PRESENT PREVIOUSLY 
IsOPEN INPUT'Q* OPEN QUTPT 
1 > CLOSED 

INVALID USER NOT PARITY 
SAYS WE ARE IN WORK AREA 

*RCPRT*0##% UPDATE POINTER 



09700000 
SEGMENT; DISK 

09700100 
09700200 
09700300 
09700400 
09700500 
09700600 
09700700 
09700800 
09700900 
09701000 
09701100 
09701200 
09701300 
09701400 
09701500 
09701600 
09701700 
09701800 
09701900 
09702000 
09702004 
09702100 
09702200 
09702300 
09702400 
09702500 
09702600 
09702700 
09702800 
09702900 
09703000 
09703100 
09703200 
09703300 
09703400 
09703500 
09703600 
09703700 
09703800 
09703900 
09704000 
09704100 
09704200 
09704300 
09704400 
09704500 
09704600 
09704700 
09704800 
09704900 
09705000 
09705100 
09705200 
09705300 
09705400 



T 0000 
ADDRESS 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000 
0000 
0000 

0000 
0000 

0000 

0000 

0000 
0000 
0000 
0000 

0000 

0000 

0000 
0000 
0000 
0000 

0000 
0000 
0000 
0000 
0000 

0000 
0000 

0000 

0000 
0000 
0000 
0000 
0000 
0000 

0000 
0000 

0000 

0000 
0000 
0000 
0000 

0000 
0000 

0000 
0000 
0000 

0000 

0000 
0000 
0000 
0000 
0000 
0000 

0000 
0000 
0000 
0000 

0000 



10 
*0 

so 

»0 

so 

»0 

so 
so 
so 
so 

SO 

SO 
so 
so 

$0 

SO 

so 

$0 

so 

SO 

so 

SO 

so 

so 

50 
1-0 

$0 

so 
so 
SO 
$0 

so 

SO 

so 
so 
so 
so 
so 
so 
so 
so 
so 
so 
SO 

so 
so 

SO 

so 
so 

SO 
$0 
SO 
so 
so 
so 
so 



00664 



m 
m 



m 
m 



$ SET 



$ 
$ 



POP 
SET 



IOERR(IQERRl) 

IOMASK 

LASTDONE 

LBLPTR 

LSUBL 

LSUBU 

MA8USE 

MAKEPRESENTWA 

MAXR 

MAXREC 

MINREC 

NOAIT 

NUMBUF 

NUMBSPC 

NUMREC 

OPENIO 

PARITY 

PBIT 

POINTPRTTOBUF 

POINTPRTTOWA 

PRESENT 
PROPER 

RCOUNT 
RCPRT 
RECPER8LK 
REDECWA 

REEOING 

resetpanderbit 
resetreadbit 

Reverse 

RDWLGTH 

SAVEWADOR 

SERIAL 

SEGPER8LK 

SETPANDERBIT 



P(0,FLCC*IOERRl,17,C0M,DEL'DEL,DEL>#> 
% ABOVE CALLS IOERROR ROUTINE 



OUtl9*475l3 »> % 

FI8H33 ,C2l5l] t* % 

FLOCtll ## % 

FIB Ell *> % 

FIB t33 *, % 

FiB[43,cnn#, % 

P(*RCPRT & 1 [CTC3*0,CDC)#, 
FIBC183C3J38S l03##% MAX REC 
FIBtl83.t33ll53#* % 
FIBU83,tCF3#, % 
FIBC203,C3!13#/ % 
FIBC133,C10? 93#, % 
H[93.C«3553 #, % 

FIBC113 t> % 

FIBC133 .[22:l]#, % 

FIBtl33,C20»t J ## % 
C2*l3#* % 

P((*RCPRT OR MEM) & 
PC*RCPRT & FIBC203 



USED TO WAIT FOR IOFINISH 
NOT OF LAST OPERATION DONE 
LABEL POINTER 
LOWER BOUND FOR RANDOM 
UPPER BOUND FOR DISK REC 
MAY BE USE RTNS PRESENT 



MAX REC 

MINIMUM 
AIT FOR 
NUMBER 



SZ FOR CONCATS 

sz 

RECORD SIZE 
WA WAS DFSTROYEO 
OF BUFFERS ASSIGNED 



NUMBER OF ROWS SPECIFIED 
RECORDS PER BLOCK 
1« OPEN INPUT-QUPUT (DISK) 
10 ERROR OCCURED IN BLOCK 
PRESENCE BIT 
TIP CCTC3*RCPRT#0#» 
CCTC3*RCPRT#*)#* 



■<C*DLOC),C2»13)#j. % CHECKS PRESENTSBIT 
*REVERSE+C0DE+C0DE+2i#»%GENERATES PROPER IOERR 
= FIBC73 t* % RECORD COUNT 

= (FI8£203,tFF3)#* %PRT OF DESC POINTING TO REC 
= HC0].C30«12J ## % RECORDS PER BLOCK 

« P(MKS*RCPRT»MAXREC/1*1#1#INTINT)#* 

% DECLARE SAVE ARRAY FOR WORK AREA 
- (C*DL0C),C24! 133#*%LAST 10 WAS READ 

FlBC133j**P(DUP)40Ci9U9i23##XRESET ERR BITS 



READ 8IT 



SETPRESENTSBIT 
SETREADBIT 
OMIT = 

sleep 

OMIT 

OMIT * TIMESHARING 



NOT(TIMESHARING) 
- 36 #> 



= 0t24!24:i]#, % USED TO TURN OFF 

= FIBC53, [44*13 *, % ^REVERSE INPUT 

* HC13## % ROW LGTH FROM HEADER 

= FIB[203**P'(DUP)«*P(RCPRT)tCTC3##% SAVE ADDRESS 

= FIBU3, [27533=0 *>% FILE ACCESS « SERIAL 

- HC03.C42J63 *, % SEGMENTS PER BLOCK 

B FIB[133:**P(DU p )&3U9:46«23## 

% SET PARITY AND IOERR 19 BITS 
■PCTIP OR MEM ,DLOC**>#,% SET PRESENCE 
= H24*47U]#, %USED TO TURN READ 



BIT 

8IT 



ON 



TECHA 

TERMCTERMl ) 

TIP 

TOSZF 

TOTREC 

UT 

WA 

WAITIO 



LABEL 
LABEL 



sCFIBC53»C46?23sl)##X TECHNIQUE- A 

* PC1,FL0C#TERMJ,17*C0M)#,%TERMINATE I/O ERROR 

= (*DLOC) t, % LOAD I/O DESC 

- [8*38Jl03#, % TO SIZE FIELD 
s H[7] *, % TOTAL RECORDS ON FILE 

- CFI8C43,C8J43)## % HARDWARE TYPE 
= P(RCPRT,DIB 0,LOD)#>% LOAD WORK AREA PTR 
■ PCDLOC* IOMASK, % THIS SLEEPS ON I/O 

SLEEP>COM#DEL*DEL)#>* WAITING FOR A COMPLETE 
WOROSLEFT * FI8tl73#* % WORDS LEFT IN BUFFER 
WRITBACK * FIBtl33,C23J13#; * FLAG TO SAY WRITE BACK 

moove>flote>seekrtn,start#readrev; 
serialio,sioeod»Rndeod#eofsetckj 



09705500 


T 


0000«0 


09705600 


T 


000050 


09705700 


T 


0000*0 


09705800 


T 


000050 


09705900 


T 


0000 5 


09706000 


T 


0000«0 


09706100 


T 


0000*0 


09706200 


T 


000050 


09706300 


T 


0000 5 


09706400 


T 


000050 


09706500 


T 


000050 


09706600 


T 


ooooso 


09706700 


T 


000050 


09706800 


T 


0000*0 


09706900 


T 


000050 


09707000 


T 


00005 


09707100 


T 


0000*0 


09707200 


T 


0000*0 


09707300 


T 


0000*0 


09707400 


T 


0000*0 


09707500 


T 


0000*0 


09707600 


T 


000050 


09707700 


T 


0000*0 


09707600 


T 


000050 


09707900 


T 


ooooso 


09708000 


T 


000050 


09708100 


T 


0000 5 


09708200 


T 


000050 


09708300 


T 


000050 


09708400 


T 


0000*0 


09708500 


T 


000050 


09708600 


T 


000050 


09708700 


T 


000050 


09708800 


T 


0000*0 


09708900 


T 


0000*0 


09709000 


T 


000050 


09709100 


T 


0000*0 


09709200 


T 


0000*0 


09709300 


T 


0000*0 


09709400 


T 


0000*0 


09709500 


T 


0000*0 


09709600 


T 


0000*0 


09709601 


T 


0000*0 


09709700 


T 


000050 


09709900 


T 


0000*0 


09710000 


T 


000050 


09710100 


T 


0000*0 


09710200 


T 


0000*0 


09710300 


T 


000050 


09710400 


T 


0000*0 


09710500 


T 


0000*0 


09710600 


T 


0000*0 


09710700 


T 


0000*0 


09710800 


T 


0000*0 


09710900 


T 


0000*0 


09711000 


T 


0000*0 


09711100 


T 


0000*0 






c; 






THEN 



* SET OMIT 



LABEL ERR£ND,MOOVERR,REREAD,LCKHANDLEp; 

SUBROUTINE GOUSE* % THIS CALLS USE ROUTINES 

BEGIN 

P(MKS,T*0*PERFORMER); 

END gouse; 

SUBROUTINE ERROR; STHlS PROCESSES ALL ERRORS 

BEGIN 
IF REEDING AND CODE AND (NUMREC*1) 

* SET OMIT = NOT SHAREDISK 

THEN * SKIP ERROR CODE 
ELSE BEGIN 

IF OPENIO THEN IF CTI *RTl ■PGUSEU1 , A-RR > / 

GOUSE ELSE ELSE XWAS ERROR ON 10 
IF REEDING AND CNQT CODE) THEN XREAD ERROR 
IF (T?=rT:=PGU5eU].BRR) X THEN 

GOUSE ELSE ELSE 
IF (T:=PGUSEE53.BRR) / THEN GOUSe; XWRITE ERROR 

if (t«-fibc15].bf) * then gouse; % error on flle»n 

not sharedisk 

if reeding and (not code) then 

begin %check use proc for 

ik erbit then %input errors 
if (t or rt) = then i0errc19); 

erbit != false; 

end else termc20); skwrite err term 

end; 

ERREND! 

end error; 
subroutine m0verec; 

BEGIN 

IF NOT DONE THEN 

* SET OMIT ~ NOT SHAREDISK 

waitio; 

IF NOT PRESENT THEN 
BEGIN 

setpresentsbit; 
setpanderbit; 
$ set omit = not sharedisk 

if not reeding then 

BEGIN 

DEST im WA; 

pctip inx n; 
go moove; 
end; 
i set omit = sharedisk 

end; 

$ POP OMIT 

S SET OMIT = NOT SHAREDISK 

PC8UFT0P INX(BS<-NUMWDSx( R COUNT MOD NUMREO+ l))J 
WA; 3MQVE TO/FROM WA 

DEST * IF CODE THEN PCXCH) ELSE P; XFQR READ OR WRITE 
MOOVE! STREAM(FR0M«-PSNUMWDS*E*PCDUP)*C37S53#DEST*P(*PC,DEST))); 

BEGIN 
Si»=FROM; E(DS»«32 WDS; DSls32 wds); dSisnumwds wds; 

end stream; 

P(DEL); 

IF PARITY THEN 



SHOVES DATA TO AND FROM WORKAREA 

% OONT MOVE TILL 10 DONE 

%GOT AN ERROR 
%SET ERROR FLAGS 



%ERROR ON OUTPUT 
%MOVE FIRST RECORD 
STO WORK AREA 



09711150 
09711200 
09711300 
09711400 
09711500 
09711600 
09711700 
09711800 

09711809 

09711820 

09711900 

0971200Q 

09712100 

09712200 

09712300 

09712400 

09712500 

09712600 

09712609 

09712700 

09712800 

09712900 

09713000 

09713100 

09713200 

09713300 

09713350 

09713400 

09713500 

09713600 

09713700 

09713709 

09713750 

09713800 

09713900 

09714000 

09714100 

09714104 

09714200 

09714300 

09714400 

09714500 

09714600 

09714700 

09714799 

09714800 

09714801 

09714809 

09714900 

09715000 

09715100 

09715200 

09715300 
09715400 
09715500 
09715600 
09715700 



T 

T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 

T 



0000*0 

oooojo 

000 J*0 
0001*0 
0002*0 
0002*1 
0003*0 
0003*0 

0005*1 
0005*1 
0005*3 
0006*3 
0010*3 

0012*2 
00H*3 
0017*3 
0019*2 
0024*0 
0028*0 
0028*0 
0029*3 
0030*1 
0031M 
0035*2 
0038*0 
0039*3 
0039*3 
0039*3 
0040*0 
0040*0 
0040*0 
0041*1 
0041*1 
0044* 1 
0045*2 
0046*0 

0047*2 
0050*0 
0050*0 
0051*1 
0051*3 
0054*0 
0055*0 
0055*2 
0055*2 
0055*2 
0055*2 
0055*2 
0055*2 
005910 
0060*3 
006213 

0065*0 
0065*0 
0067*0 
0067*1 
0067*2 



€ 
• 



# 



• 
# 






• 



BEGIN 

mooverr: error* 

$ set omit * not shareoisk 

end; 
end moverec; 
* set omit = not sharedisk 
subroutine diskaddress; %thls computes the disk address read & writ 

BESlN 

RT ♦■ SEGPERBLK x DAS; % REL SEGMENT NO 

IF PCRT DIV ROWLGTH,DUP) GEQ NUMBSPC THEN 
BEGIN 
$ SET OMIT = NOT SHAREDISK 

PC1>RTN); 

end; 

IF CBS+HtCT* P + 10)]} = THEN 
BEGIN 

getseg; 

if howopen/0 then if not openio then i0err(22); 
as «. hcti; 
end; 
streamc a «- bs «• bs + rt mod rowlgth* 

b*t«-buft0pt[cf3-clf code then else writback)); 
begin si«-uoc a; ds*8 dec; end; 
$ set omit = not sharedisk 

end diskaddress; 
subroutine rotatebuf; %this rotates buffers 

BEGIN 

if numbuf > 1 then 

pcnum8uf/dl0c* 13, 11, com* del* del* del); 
wordsleft := buffsize; 
resetpanderbit; 
fibc163.ccf3 $ = tip; 
end rotatebuf; 
subroutine prel; % this does actual i/o 

BEGIN 

pc tip*dloo; 

if writback then % do special write-iq 

8EGIN 

writback «• False; % turn off read bit 

DL0CC03* TIP&RESETREADBITU to make write 

end; 

pcprl*del>; % do i-o 

if break then breakout; 
eno prEl; 
subroutine reed* *this reads blocks 

BEGIN 

wordsleft := buffsize; 

olocc03 := flag(buft0p & setreadbit); %t0 reset 100 

code <• p(c0de*0); 

diskaddress; 

code ♦ p; 

$ SET OMIT = NOT SHAREDISK 

MEM[BUFTOP INX NOT 23 <• DaS; % SAVE BLOCK NUMBER 

prel; 

fibc163.ccf3 j= tip; ssave buff address 

END reed; 
SUBROUTINE WRIT; XTHIS WRITES BLOCKS 



09715710 
09715730 
09715739 

09715760 
097j5800 
09715809 
09715900 
09716000 
09716100 
09716200 
09716210 
09716219 
09716240 
09716250 
09716300 
09716400 
09716500 
09716600 
09716700 
09716800 
09? 16900 
09717000 
09717100 
09717109 
09717200 
09717300 
09717400 
09717500 
09717600 
09717700 
09717800 
09717900 
09718000 
09718100 
09718200 
09718300 
09718400 
09718500 
09718600 
09718700 
09718800 
09718900 
09719000 
09719100 
09719200 
09719300 
09719400 
09719500 
09719600 
09719700 
09719800 
09719804 
09719900 
09720000 
09720100 
09720200 
09720300 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0068»2 
0069»0 
007o*0 

0070*0 
0070*0 

0070*1 
0070*1 
0071*0 

0071*0 
0073*0 

0075*2 
0076*0 
007650 
0076*2 
0076*2 
0078*3 
0079*1 

0086*0 
009i *3 

0092*3 
0092*3 
0095*0 
0099*2 
0100*1 
0100*1 
0100*2 
0101*0 
0101*0 
0102*2 
0105*3 
0107*3 
0110*1 
0112*2 
0112:3 
0113*0 
0113*0 
0113*3 
0114*3 
0115*1 
0117*3 
0119*3 

0119*3 
0120*2 
0125*3 
0126*0 
0126*0 
0126*0 
0128*0 
0130*1 
0131*1 
0132*0 

0132*2 
0132*2 
0135*0 
0136*0 
0138*1 
0138*2 






$ SET OMIT 



BEGTN 

WORDSLEFT ?■ BUFFSIZE/ 
WRITBACK «• FALSE) 

das ;s bcount; 
dlocc03 * = flagcbuftop & 
diskaddress; 
not sharedisk 
prel* 

fibi163.[cf3 j* tip; 
if not(serial) then 8cqun 
end writ; 
subroutine seek/ *this finos 

BEGIN 

IF (DAS *- RCOUNT OIV NUMREC) a 
BEGIN 
= NOT SHAREDISK 

go seekrtn; 
end; 

SERIAL THEN 
BEGIN 

IF NOT HOWOPEN THEN 
BEGIN 

IF RCOUNT < TOTREC T 
IF NUMREC > I THEN 
BEGIN 
NUMBUF 5= II 



RESETREADBIT); 



*BIQCK ADDRESS 
%RESET IOD 



%SAVE BUFF ADDRESS 
T J* MEMCBUFTOP INX NOT 23; 

AND/OR READS BLOCKS 

BCOUNT THEN 



i SET OMIT 



IF 



*NQT INPUT 
HEN TOTREC J* RCOUNT; 

^BLOCKED OUTPUT 
%FILL ONLY ONE 



IF CW0RDSLEFT<BUFFSI2E) THEN 
BEGIN 
IF NOT OPENIO THEN 

BEGIN % SERIAL OUTPUT - NO 
DASjsPCDAS, BCOUNT); 
CODEi=PCCODE#l); 
DISKADDRESS; 
CODEJ=p; oas:=p; 
end; 
writback«strue; 
end; 

end; 
end; 
if numbuf * 1 then 
if (das<cqunt) and (das>b 
IF memcdloccnumbuf-1 

DAS 8* COUNT + 
COUNT ** (RCOUNT DlV NUMR 
DO BEGIN 

IF NOT OONE THEN WAI 
IF NOT PRESENT THEN 
IF NOT REEDING 

THEN MOVER 
IF DAS x NUMREC 
THEN REED 
END UNTIL (DAS Is DA 
IF NOT HOWOPEN THEN WAITI 
BCOUNT »* DAS *• DAS - NUM 
NUMBUF I* BUFFNUM; 
END ELSE 
IF HOWOPEN OR (NUMREC > 1) 



ADDR IN BUFF 



COUNT) THEN XBLOCK IS PRESENT 
3 INX NOT 23 = COUNT THEN 

I* 

EC) + NUMBUF - i; 

tio; 



EC else setpresentsbit; 

< LSUBU 

else rotatebuf; 
s + i> > count; 
o; 
buf; 



XMUST BE RANDOM 



09720400 
09720500 
09720600 
09720700 
09720800 
09720900 
09720904 
09721000 
09721100 
09721120 
09721200 
09721300 
09721400 
09721500 
09721510 
09721519 
09721570 
09721580 
09721600 
09721700 
09721800 
09721900 
09722000 
09722100 
09722200 
09722300 
09722400 
09722405 
09722410 
09722415 
09722420 
09722425 
09722430 
09722435 
09722440 
09722445 
09722450 
09722500 
09722600 
09722700 
09722800 
09722900 
09723000 
09723100 
09723200 
09723300 
09723400 
09723500 
09723600 
09723700 
09723800 
09723900 
09724000 
09724100 
09724200 
09724300 
09724400 



T 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
P 
C 
C 
C 
C 
C 

c 
c 
c 
c 
c 

T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 

T 

T 



0139*0 
0139»0 
0141*0 

0143«2 
0144*2 
0146*3 
0148*0 
0148*0 
0149*0 
0151*1 

0156*1 
0156*2 
0157*0 
0157*0 
0159*2 
0160*0 
0160*0 
0160*2 
0160*2 
0162*0 
0162*2 
0163*3 
0164*1 
0167*2 
0168*2 
0169*0 
0l7i*2 

0173*1 
0173*3 
0175*0 
0175*2 
0176*3 
0177*3 
0l79?0 
0180*0 
0180*0 
0182*2 
0182*2 
0182*2 
0182*2 
0184*0 
0186*3 
0191*3 
0193*3 
0197*3 
0197*3 
020^10 
0203*1 
0204*3 
0209*0 
0210*1 
0214*0 
0216*2 
0220*3 
0223*3 
0227*0 
0227*0 



• 



• 



# 
• 



jr * 



% INPUT OR BLOCKED OR LOCK 



S SET OMIT - NOT SHAREDISK 
THEN BEGIN 
REREADS 

IF NUMBUF ■ 1 THEN % JUST READ DONT TRY TO FIND 
BEGIN IF NOT DONE THEN 
S SET OMIT - NOT SHAREDISK 

waitio; 

reed; 

BCOUNT*DASi 
END 
ELSE BEGIN 

FOR T I* }, STEP 1 UNTIL NUMBUF -1 

DO %FIND BLOCK IN CORE 

IF MEMCDLOcm INX NOT 23 ■ DAS THEN 



* SET OMIT = SHAREDISK 

$ POP OMIT 

$ SET OMIT a NOT SHAREDISK 

$ SET OMIT = NOT SHAREDISK 



FLOTES 

$ SET OMIT * NOT SHAREDISK 



GO flote; 



IF NOT DONE THEN 

WAITIO* 
REED; %MAKE PRESENT IN CORE 
IF CODE < 2 

then begin 

if wrltback then %read or 
begin &write 
writ; 

DAS * = RCOUNT DIV NUMREC/ 

end else rotatebuf; 
while memctip inx not 23 / das 
do rotatebuf; 

BCOUNT is DAS; 

end; 



SEEKRTN; 



end; 



end; 






ENOFILE is FALSE; 
WORDSLEFT 5 s BUFFSIZE - ((RCOUNT MOD NUMREC) * NuMWDSj; 
LASTDONE «■ FALSE; % PREVENT SERIALIO OVERWRITE 

if code * 2 then p(xit>; 
end seek; 

%***% START YEE HERE YEE DISKERS %***% 
STARTS 

FIB »■ *(FLOC (s (not 2) INX DLOC); 
IF NOT DISK THEN 
BEGIN 

FLOC ss P(,RCW#LOD); 
Fie *■ ABSCCODE); 
DEST != P(,DL0C*L0D>; 

bs * = numwos; 
CODE s= i; 

RCW S= DLOC Sa NUMWDS Ss 0; 

P(CFL0C3fDUP*0#XCH»CFX#STF#1# inx^sts); 

GO TO P(COBOLIONONDSK); 

End; 

H Ss *CFlBt 1*33* 



09724409 


T 


0229S1 


09724500 


T 


0229«t 


09724550 


T 


0230S1 


09724600 


T 


023011 


09724700 


T 


02315 3 


09724709 


T 


0233'2 


09724750 


T 


0233S2 


09724760 


T 


0236*2 


09724770 


T 


0238*0 


09724780 


T 


023951 


09724800 


T 


0239* J 


09724900 


T 


0239»3 


09725000 


T 


0243*2 


09725100 


T 


0244*3 


09725109 


T 


0247*3 


09725110 


T 


0247*3 


09725111 


T 


0248*3 


09725119 


T 


0248*3 


09725300 


T 


0248*3 


09725309 


T 


0250*0 


09725390 


T 


0250*0 


09725400 


T 


0253*0 


09725500 


T 


0254*0 


09725549 


T 


0254*1 


09725600 


T 


0254*1 


09725700 


T 


0255*1 


09725800 


T 


0256*1 


09725900 


T 


0256*3 


09726000 


T 


0258*0 


09726100 


T 


0259*3 


09726200 


T 


0261*0 


09726300 


T 


0263*0 


09726400 


T 


0265*2 


09726500 


T 


0266*3 


09726600 


T 


0266*3 


09726700 


T 


0266*3 


09726800 


T 


0266*3 


09726900 


T 


0266*3 


09727000 


T 


0269*1 


09727100 


T 


027351 


09727200 


T 


0275*3 


09727300 


T 


0277*1 


09727400 


T 


0277*2 


09727500 


T 


0277*2 


09727600 


T 


0280*0 


09727700 


T 


0282*1 


09727800 


T 


0283*3 


09727900 


T 


0284*1 


09728000 


T 


0285*1 


09728100 


T 


0286*1 


09728200 


T 


0287*1 


09728300 


T 


0288*0 


09728400 


T 


0288*3 


09728500 


T 


0290*2 


09728600 


T 


0293*1 


09728700 


T 


0293*3 


09728800 


T 


0293*3 



$ 


SET 


GM 
IF 


$ 


SET 


OM 
IF 


$ 


SET 


DM 

IF 
IF 



IF 

IF 



REAOREV! 



% % 
SERIALIO' 



it = not sharedisk 
code. [1113 then 

begin code«-abs(code)! 
it = not sharedisk 

end; 
code > 2 then if cooe * 
begin if howopen > 1 t 
if not openio th 
it ■ not sharedisk 

go eofsetck; 
end; 

HQWOPEN > 1 THEN 
CODE = 2 THEN 

BEGIN RCOUNT«-UF KEY = 
IF CRCOuNT<LSUBL) OR 

go eofsetck 
else if invaliduser t 

else seek; 
end; 
not openio then 

IF (1 - CODE) t HOWOPE 
SERIAL THEN % P 

SEGIN 

if openio then go serl 

if (rcount<lsubl) or ( 

if code ■ or code ■ 2 

if invaliduser then t 

moverec; 

if reverse then go rea 
code then if rcount 

(WORDSLEFT 8 = *P(DU 
BEGIN 

IF CODE THEN WRIT 
IF (DAS 8 = B 
BEGIN 

reed; 

COUNT 8 
END ELS 

bcount := * p(dup 

end; 
rcount !■ *p(dup) + i* 
if false then 

BEGIN 

IF (WORDSLEFT * * 
BEGIN 

IF (DAS «- BC 
BEGIN 
END EL 
BCOUNT «■ *P( 

end; 

RCOUNT * *P(DUP) 

END revinput; 

IF KEY jf- THEN PCRCQU 
P(0,RTN)! 
D OF SERIAL 



IF 
IF 



E N 



6 THEN TERM(25) ELSE XHRITE BLOCK 

HEN TERM(37); 

EN IF HOWOPEN THEN TERM( 34 + RE VERSE ) I 

%WRITFS BLOCK5IMMEDIATE-NO ROTATION 
TERM(31 + CODE); 

THEN ELSE P(KEY,DIB 0,LQD)) - II 
(RCOuNT>LSUBU) THEN 

% INVALID KEY 
HEN TERM(0)% DS WITH INVALID USER 

%ONLY SEEK VALID RECORDS 



N THEN TERMCPROPER)! 
R0CE5S SERIAL FILE 

alio; 

rcount>lsubu) then 60 eofsetck! 
then% read or seek (serial) 
erm(o); % ds with invalid user 

drev; 

> totrec then totrec is rcount! 
p) - numwds) < then 

%BLOCK IS EXHAUSTED 
ELSE 
COUNT + NUMBUF) x NUMREC < LSUBU THEN 

SREAD AHEAD TO KEEP 

^BUFFERS READY 
* DAS; 

e rotatebuf; 

) + i; 



% this code executed only for tape 
% open-reverse equated to disk 

p(dup) - numwds) s then 
% block is exhausted 

ount » numbuf) x numrec 2 lsubl then 

reed; count «• das; 

se rotatebuf; 

dup) - i; 

* l ; 

NT*KEY>DI8 0#lSD)J 
---- 10 NEXT % % 



RCOUNT «■ *P(DUP) 



(T ♦ (CODE AND LASTDONE))! 



09728804 
09728815 
09728820 
09728824 
09728890 
09728900 
09728930 
09728960 
09728979 
09729000 
09729050 
09729100 
09729200 
09729300 
09729400 
09729500 
09729510 
09729520 
09729600 
09729700 
09729800 
09729900 
09730000 
09730100 
09730200 
09730210 
09730220 
09730300 
09730400 
09730500 
09730600 
09730700 
09730800 
09730900 
09731000 
09731100 
09731200 
09731300 
09731400 
09731500 
09731600 
09731700 
09731800 
09731900 
09732000 
09732100 
09732200 
09732300 
09732400 
09732500 
09732600 
09732700 
09732800 
09732900 
09733000 
09733100 
09733200 



0295*0 
0295*0 
0295*3 
0297»1 
0297*1 
0297*1 
030150 
0304*3 
0310*2 
0310*2 
03U»0 
031H0 
03H*3 
0315*2 
032183 
0324*2 
0324*2 
0328*0 
0330*0 
0330*0 
0331U 
0337*3 
0339*1 
0339*3 
0341J2 
0345*0 
0346*3 
0350*0 
0351*0 
0352*3 
0356*3 
0359*1 
0359*3 
0362*0 
0366*1 
0366*3 
0368*0 
0369*1 
037180 
0373*0 
0373S0 
375*0 
0375*1 
0375*3 
0378*1 
0378*3 
0382*2 
0385*1 
0387*0 
0389*0 
0389*0 
039180 
0391J0 
0395*0 
0395*2 
0395*2 
0395*2 






V * 



t * 



# 
• 



CRCOUNKLSUBL) OR ( RCOUNT>LSUBU ) THEN GQ EOFSETCK; 

2 THEN XREAD OR SEEK (SERIAL I/O) 
TERMCQ)J% DS WITH INVALID USER 
*P(DUP) + NUMWDS ELSE 



IF 

IF CODE = OR CODE ■ 

IF INVALIDUSER THEN 

IF T THEN WORDSLEFT * 

IF WORDSLEFT < THEN 
BEGIN 

IF CDAS ;= BCOUNT 
BEGIN 

reed; 

COUNT 



%BLOCK IS EXHAUSTED 
NUMBUF) x NUMREC < TOTREC THEN 
%ANOTHER BLOCK 
% IN SIGHT 



= das; 

END ELSE 

IF WRITBACK THEN 

WRIT 

ELSE % 

rotatebuf; 

8s *P(OUP) + 



OR 



% WRITE CURRENT BLOCK 
% LESS WE FQRGIT 
USE NEXT BUFFER 
% BECAUSE ITS THERE 



RCOUNT ELSE 

GO sioeod; 



End; 



BCOUNT U *pcoup) + i; 
end; 
if rcount > totrec then 
if code then totrec 
begin c0de<-32; 

MOVEREc; 
SIOEOD* IF (WORDSLEFT l» *P(DUP) - NUMWDS) < THEN 

IF CODE THEN %WROTE LAST RECORD 
BEGIN % OF YEE BLOCK 

IF (DASJ=8CQUNT+NUMBUF)XNUMREC S TOTREC THEN 
BEGIN XREAD AHEAD TOO 

WRITBACK ** TRUE; %KEEP BUFFERS FULL 

reed; 

count != das; 

end else % write block now 
writ; % ...a write in time*.. 

BCOUNT is *P(DUP) + U 

END EL S E 
ELSE IF CODE THEN WRITBACK *« TRUE; %NOT FULL BLK 
LASTDONE J= NOT CODE; 

IF KEY t THEN P (RCOUNT* I* *> KEY* D IB 0»1SD); 
RCOUNT :- *P(DUP) + i; 

IF C0DE=32 THEN GO EOFSeTCK ELSE P(0*RTN); 
END SERIAL; % END OF ALL SERIAL PROCESSING 
%%% RANDOM AND RANDOM 10 START HERE %%% 

RCOUNT 5= (IF KEY * THEN ELSE P(KEY*0IB 0*L00)) - \i 

IF (RCOUNT<LSUBL) OR ( RCOUNT>LSUBU) THEN GO EOFSeTCK; 

IF CODE = OR CODE m 2 THEN %READ OR SEEK (RDM OR RDM I/O) 

IF INVALIOUSER THEN TERM(0);% DS WITH INVALID USER 
IF RCOUNT > TOTREC THEN 

IF CODE THEN TOTREC «• RCOUNT ELSE 

BEGIN CODE ♦ 32; GO RNDEOD; END; 
* SET OMIT = NOT SHAREDISK 

IF (DAS «■ RCOUNT DIV NUMREC) * BCOUNT THEN 
IF (NUMRECXCODE) 

THEN SEEK % READ OR BLOCKED WRITE 

ELSE MEMCBUFTOP INX NOT 2) *=BCOUNT **DAS* 

moverec; 

RNOEOD* WORDSLEFT * = *P(DUP) - NyMWDS; 
IF CODE THEN 

IF NUMREC = 1 ^UNBLOCKED OUTPUT 

$ SET OMIT s NOT SHAREDISK 



09733300 


T 


0399*1 


09733310 


C 


0402?3 


09733320 


C 


0404*2 


09733400 


T 


0407»3 


09733500 


T 


0410*2 


09733600 


T 


0412»0 


09733700 


T 


0412*2 


09733800 


T 


0416*1 


09733900 


T 


0416*3 


09734000 


T 


0418*0 


09734100 


T 


0419*1 


09734200 


T 


0419*1 


09734300 


T 


0420*3 


09734400 


T 


0422*0 


09734500 


T 


0422*0 


09734600 


T 


0424*0 


09734700 


T 


0426*0 


09734800 


T 


0426*0 


09734900 


T 


0427*1 


09735000 


T 


0430*0 


09735100 


T 


0431*3 


09735200 


T 


0433*0 


09735300 


T 


0435*2 


09735400 


T 


0436*1 


09735500 


T 


0436*3 


09735600 


T 


0440*2 


09735700 


T 


0441*0 


09735800 


T 


0443*2 


09735900 


T 


0445*0 


09736000 


T 


0446*1 


09736100 


T 


0446*1 


09736200 


T 


0448*0 


09736300 


T 


0450*0 


09736400 


T 


0450*0 


09736500 


T 


0454*1 


09736600 


T 


0457*0 


09736700 


T 


0461*2 


09736800 


T 


0463*2 


09736900 


T 


0465*1 


09737000 


T 


0465*1 


09737100 


T 


0465*1 


09737200 


T 


0471*0 


09737210 


C 


0474*2 


09737220 


C 


0476*1 


09737300 


T 


0479*2 


09737400 


T 


0480*3 


09737500 


T 


0483*2 


09737549 


T 


0485*1 


09737600 


T 


0485*1 


09737700 


P 


0487*3 


09737710 


C 


0488*3 


09737720 


c 


0490*2 


09737800 


■ T 


0495*0 


09737900 


T 


0496*0 


09738000 


T 


0498*0 


09738100 


T 


0498*1 


09738109 


T 


0499*2 



n 



$ SET OMIT 



THEN BEGIN 

WRIT* 
NOT SHAREDISK 

END ELSE 

WRITBACK ♦• TRUE* 
IF C0DE*32 THEN PCO,RTN)J 



E0F5ETCKJ 



IF 



CWQR 



THEN 



$ SET OMIT 



BE 
NU 
WR 
WA 
NU 
IF 



NOT 



EN 
IF CODE 
IF SERI 

IF 
IF CODE 

BE 

EN 

IF CODE 

BE 

* SET OMIT » NO 

P( 

EN 

LA 

%%% END OF EO 

END OF COBOL DIS 



DSLEFT 
OTCHQW 
GIN 
MBUF J 

it; 
itio; 

MBUF $ 

NOT P 

BEG 

SET 
SHAR 

ERR 

D END 

s 6 T 

AL AND 

ENDFI 

= 32 

GIN H 

FOR 

d; 

/ 2T 
GIN 

T SHAR 
1»RTN) 
D ELSE 
STDQNE 
F CHEC 
K INTR 



< BUFFSIZE) AND 
OPEN) OR CQPENIO 



1. 



AND WRITBACK)) 

XWRITE LAST BUFFER 
SAND CHECK FOR 
TERRORS 



« B 

RES 

IN 

PRE 

EDI 

or; 



uffnum; 

ENT THEN 

sentsbit; 

SK 



HEN P(0,RTN); 
CODE * 2 THEN % ONLY 1 EOF ALLOWED 

LE THEN TERMC15) ELSE ENDFlLE * TRUE; 

THEN % CLEAR WORK AREA 

«■ WA; % IF READ BEYOND EOF 
RT <- STEP 1 UNTIL CNUMWDS-1) DO H£RT3 «• o; 

HEN % LET PROGRAM KNOW ITS EOF 



EDISK 

«• false; 

KING 

insics; 



% PREVENT SERIALIO OVERWRITE 



09738120 


T 


04991 


2 


09738*40 


T 


0500» 


1 


09738149 


T 


05011 





09738200 


T 


05011 





09738300 


T 


050*1 





09738400 


T 


0504« 





09738500 


T 


0505! 


3 


09738600 


T 


05051 


3 


09738700 


T 


0507! 


2 


09738800 


T 


0511! 





09738900 


T 


0512! 





09739000 


T 


0514! 


2 


09739100 


T 


0516< 





09739200 


T 


05185 


2 


09739300 


T 


0521! 


3 


09739400 


T 


0523! 





09739500 


T 


0523! 


2 


09739549 


T 


0525! 





09739600 


T 


0525! 





09739700 


T 


0526! 





09739750 


T 


0526! 





09739800 


T 


0527! 


3 


09739900 


T 


0530! 


1 


09740000 


T 


0536! 


2 


09740100 


T 


0537 


1 


09740200 


T 


0540! 





09740300 


T 


0546 





09740400 


T 


0546 





0974041Q 


T 


0546 


! 3 


09740419 


T 


0547' 


1 


09740430 


T 


0547 


•t 


09740440 


T 


0547 


'3 


09740500 


T 


0547 


3 


09740600 


T 


0550 


«3 


09740700 


T 


0550 


!3 


i 


SIZE" 0551 






• 
m 



procedure interrupter; * execution forced by software interrupt code at 

start of rel 
processes enabled 
an ip1 has just been 

REG'S TO 



BEGIN 

REAL 



% 
% 
% 
% 



ADDR=+1* 

I s + 2# 

N0TD0NE=+3* 

D0«E»+4; 

REAL PERFORMGENsis; 

ARRAY TSKA =22C*]» 

% CONTENTS 



INITIATE. INTERRUPTER 
INTERRUPTS IN SFINTO, 
EXECUTED* POINTING REG-F AND 
STACK COPY OF THE OLD INCW, 



THE 



OF 



% TASK 
TSKAE83* 



ARRAY 



% [lli:»l IFF INTERRUPTER HAS JUST RUN AND 

% SFINTQ IS NON-EMPTY 

% C2S 1 3=1 IFF SFINTQ IS NON-EMPTY 

% [3:13*1 IFF INTERRUPTER IS RUNNING 

% C41UJ SFINTQ INTERLOCK BIT 

% CFF] ■ ADDRESS OF OLD IRCW 

% CCF] - RELATIVE PRT ADDRESS OF FIRST IN LINKED 



09800000 
SEGMENT; DISK 
09800100 
09800200 
09800300 
09800400 
09800500 
09800700 
09800750 
09800755 
09800760 
09800765 
09800770 
09800775 
09800780 
09800785 
09800790 



T 0000*0 
ADDRESS m §0683 



T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 
T 



0000*0 
OOOO'O 
OQOQiO 
OOOO'O 
0000*0 
OOOO'O 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 
0000*0 



<# -*. 



* 



# ** * 



* <* «►' 



% 



# 



SFINTQ 3 27C*3> 

prtbase not*]; 
label again; 
define imask = 
%***********start 
tskac83 «■ abs(*p(dup)) & 
if not tskac8] • c «h 1 ] then 

TSKACB1.CAI1] <■ O; 

pco»o,o,o>; 

again* while i<sf intq . c 8 * 10 ] do 

bfgin if sfintqcijxo then 

if mcsfintqcij + iko 

then notdone <- 

ELSE 
BEGIN 



LIST OF DECLARED INTERRUPTS 

% SOFTWARE INTERRUPT QUEUE 



P200000000000000#; 

H £ R E* * * * * * * "* * * *•■* * -* 
1 C3U7im 
PC ETSK A[ 83 ]* IMASK* 2# COM* DELUDED J 



1 



X VALID ENTRY 

% LINK WORD 

% SKIP DISABLED INTERRUPT 

% PERFORM ENABLED INTERRUPT 



ADDR *> SFlNTQtn; 

TSKAC8) «■ *PCDUP) OR IMASK; 

P(MKS#ADOR-PRTBASEttCF]#0»PERFORMGEN)J 

IF NOT TSKA[6J.t4ill THEN 

PC CTSK AC 8 33* I MASK, 2* COM, DEL* DEL); 
TSKAC81.C4U] *• 0; 

sfintqci] «• o; 
done «• 1; 



END; 



end; 
i «■ i + i; 



end 



IF DONE THEN BEGIN I * DONE ♦ NOTDONE «- 01 GO AGAIN; END. 

TSKAC81 • C 1 M] «• 12XN0TD0NE + 1; 

P(47#CQ M )^ 

interrupter; 



COMMENT DO NOT PUT ANY DECLARATIONS PAST THIS POINT OR THE CONTROL 

STATE PROCEDURE WHATlNTRNSlC WILL PROBABLY HANG THE SYSTEMJ 
PROCEDURE WHSTINTRINSic; 



09800795 


T 


0000*0 


09800800 


T 


0000*0 


09800900 


T 


0000*0 


09800920 


T 


OOOO'O 


09800940 


T 


0000*0 


09800950 


T 


0000*0 


09800955 


T 


0000*0 


09800970 


T 


0002*3 


09800980 


T 


0006*1 


09801000 


T 


0008*3 


09801100 


T 


0009*3 


09801150 


T 


0011*3 


09801200 


T 


0012*3 


09801300 


T 


0015*1 


09801400 


T 


0016*1 


09801410 


T 


0016*3 


09801420 


T 


0020*0 


09801450 


T 


0022*0 


09801460 


T 


0024*1 


09801470 


T 


0025*2 


09801480 


T 


0027*3 


09801500 


T 


0030* 1 


0980J600 


T 


003i?2 


09801700 


T 


0032*1 


09801800 


T 


0032*1 


09801900 


T 


0033*2 


09801950 


T 


0035*0 


09802000 


T 


0038*0 


09802100 


T 


0041*2 


09802200 


T 


0042*0 


SIZE= 0043 



• 

• 
• 
• 



• 



WORDS 



L* 



BEGIN 
LABEL L; 

pcxit); pc.l»oed; 



"INTRINS"* 
"ICS »Q«f 

"XVI. O t ***' 

5 PATCH LEVEL 

M OCP#>$#>§>"* 

$ SET OMIT ? 

" INCLUDE 

"ES MM"* 
M TIM£SHA"» 

M RlNr,Ppa"» 

$ POP OMIT 
« «, •• ; 

end whatintrinsic; 



ON NEXT CARD PLEASE 
NOT(TIMeSHARING) 



99998000 T 0000*0 

99998010 T 0000*0 

99998020 T 0000*0 

START OF REL SEGMENT; DISK ADDRESS s 00685 

99998030 T 0000*0 

99998040 T 0000*0 

99998050 T 0000*0 

99998100 T 0000*3 

99998200 T OOOliO 

99998300 T 0002*0 

99998400 T 0003*0 

99998500 T 0004*0 

99999000 T 0004*0 

99999100 T 0005*0 

99999840 T 0005*0 

99999850 T 0006*0 

99999860 T 0007*0 

99999870 T 0008*0 

99999880 T 0009*0 

99999890 T 0009*0 

99999900 T 0010*0 

SIZE* 0011 WORDS 






• 







END. 

NUMBER OF ERRORS DETECTED * OOO. COMPILATION TIME « 15l3 SECONDS. 
PRT SIZEs?50 BASE ADDRESS=0000 CORE REQ*0000 DISK REQ*2o580 



LABEL OOOOOOOOOLINE 00177138? EXECUTE ESPOL/DISK 



99999990 T 0000*0 

SIZE* 0000 WORDS 



ESPOL /DISK 






• 
• 



• 



i 






,. .*, m 



m ~m. % 



